home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
FishMarket 1.0
/
FishMarket v1.0.iso
/
fishies
/
326-350
/
disk_347
/
cursor
/
baslib.asm
< prev
next >
Wrap
Assembly Source File
|
1992-05-06
|
112KB
|
6,031 lines
;
; Cursor V1.0
; (c) 1990 by Jürgen Forster
;
; die Register D0-D7 und A0-A3 sind jederzeit von Funktionen, die
; ihre Parameter über den Stack bekommen, verfügbar.
; A4 zeigt auf eine lokale Variablentabelle
; A5 zeigt auf die Tabelle der globalen Variablen und konstanten Strings
; A6 zeigt auf die BASBASE-Struktur, muß gerettet werden!
VERSION EQU 1
REVISION EQU 270
NOLIST
INCLUDE exec/types.i
INCLUDE exec/initializers.i
INCLUDE exec/io.i
INCLUDE exec/libraries.i
INCLUDE exec/lists.i
INCLUDE exec/resident.i
INCLUDE exec/strings.i
INCLUDE exec/memory.i
INCLUDE exec/execbase.i
INCLUDE exec/tasks.i
INCLUDE libraries/dos.i
INCLUDE libraries/dosextens.i
INCLUDE intuition/intuition.i
INCLUDE devices/inputevent.i
INCLUDE devices/conunit.i
INCLUDE offsets.i
INCLUDE libmacros.i
LIST
XREF _CreatePort
XREF _DeletePort
XREF _CreateStdIO
XREF _DeleteStdIO
; **********************************************************************
; * *
; * Unterstützung der Library *
; * *
; **********************************************************************
STRUCTURE BASBASE,LIB_SIZE
BPTR BASBASE_SEGLIST
LABEL BASBASE_SIZEOF
moveq #RETURN_FAIL,d0
rts
ROMTag
dc.w RTC_MATCHWORD
dc.l ROMTag
dc.l EndCode
dc.b RTF_AUTOINIT
dc.b VERSION
dc.b NT_LIBRARY
dc.b 0
dc.l bas_runtimeName
dc.l idString
dc.l Init
bas_runtimeName
dc.b 'bas_runtime.library',0
idString
dc.b 'bas_runtime.library 1.0 (30 Mar 1990) (c) 1990 Jürgen Forster',CR,LF,0
even
Init
dc.l BASBASE_SIZEOF
dc.l functable
dc.l datatable
dc.l InitLib
functable
dc.l OpenLib
dc.l CloseLib
dc.l ExpungeLib
dc.l ExtFuncLib
dc.l INIT__
dc.l END__
dc.l ABS_D_D
dc.l ABS_I_I
dc.l ABS_L_L
dc.l ABS_R_R
dc.l ADD_DD_D
dc.l ADD_II_I
dc.l ADD_LL_L
dc.l ADD_RR_R
dc.l ADD_TT_T
dc.l AND_II_I
dc.l AND_LL_L
dc.l AREAFILL_I_
dc.l AREAFILL__
dc.l AREA_II_
dc.l ASC_T_I
dc.l ATN_D_D
dc.l ATN_R_R
dc.l BEEP__
dc.l BREAKOFF__
dc.l BREAKON__
dc.l BREAKSTOP__
dc.l CALL_Z_
dc.l CHDIR_T_
dc.l CHECKINPUTEND__
dc.l CHR_I_T
dc.l CIRCLE_IIIIRRR_
dc.l CIRCLE_IIIIRR_
dc.l CIRCLE_IIII_
dc.l CIRCLE_III_
dc.l CLEAR__
dc.l CLOSE_I_
dc.l CLOSE__
dc.l CLS__
dc.l COLLISIONOFF__
dc.l COLLISIONON__
dc.l COLLISIONSTOP__
dc.l COLLISION_I_I
dc.l COLOR1_I_
dc.l COLOR2_I_
dc.l CONVERT_D_I
dc.l CONVERT_D_L
dc.l CONVERT_D_R
dc.l CONVERT_I_D
dc.l CONVERT_I_L
dc.l CONVERT_I_R
dc.l CONVERT_L_D
dc.l CONVERT_L_I
dc.l CONVERT_L_R
dc.l CONVERT_R_D
dc.l CONVERT_R_I
dc.l CONVERT_R_L
dc.l COS_D_D
dc.l COS_R_R
dc.l CSRLIN__I
dc.l CVD_T_D
dc.l CVI_T_I
dc.l CVL_T_L
dc.l CVL_T_R
dc.l DATE__T
dc.l DIMDOUB_FP_
dc.l DIMINT_FP_
dc.l DIMLONG_FP_
dc.l DIMREAL_FP_
dc.l DIMTEXT_FP_
dc.l DIMSHAREDDOUB_FP_
dc.l DIMSHAREDINT_FP_
dc.l DIMSHAREDLONG_FP_
dc.l DIMSHAREDREAL_FP_
dc.l DIMSHAREDTEXT_FP_
dc.l DIV_DD_D
dc.l DIV_II_I
dc.l DIV_LL_L
dc.l DIV_RR_R
dc.l DOUBLE_D_DD
dc.l DOUBLE_I_II
dc.l DOUBLE_L_LL
dc.l DOUBLE_R_RR
dc.l DOUBLE_T_TT
dc.l ENDSUB__
dc.l EOF_I_I
dc.l EQV_II_I
dc.l EQV_LL_L
dc.l EQ_DD_D
dc.l EQ_II_I
dc.l EQ_LL_I
dc.l EQ_RR_R
dc.l EQ_TT_I
dc.l ERASE_f_
dc.l ERL__I
dc.l ERROR_L_
dc.l ERR__I
dc.l EXP_D_D
dc.l EXP_R_R
dc.l FILEINPUT_I_IT
dc.l FILELINEINPUT_I_T
dc.l FILEPRINTRETURN_I_I
dc.l FILEPRINTTAB_I_I
dc.l FILEPRINT_ID_I
dc.l FILEPRINT_II_I
dc.l FILEPRINT_IL_I
dc.l FILEPRINT_IR_I
dc.l FILEPRINT_IT_I
dc.l FILES_T_
dc.l FILES__
dc.l FIX_D_D
dc.l FIX_R_R
dc.l FORGET_D_
dc.l FORGET_I_
dc.l FORGET_L_
dc.l FORGET_R_
dc.l FORGET_T_
dc.l FRE_I_L
dc.l FRONTCOLOR__I
dc.l GETCOLOR0__I
dc.l GETDOUBELEMPOINTER_FP_L
dc.l GETDOUBELEM_FP_D
dc.l GETINPUTPART__T
dc.l GETINTELEMPOINTER_FP_L
dc.l GETINTELEM_FP_I
dc.l GETLONGELEMPOINTER_FP_L
dc.l GETLONGELEM_FP_L
dc.l GETREALELEMPOINTER_FP_L
dc.l GETREALELEM_FP_R
dc.l GETTEXTELEMPOINTER_FP_L
dc.l GETTEXTELEM_FP_T
dc.l GETWINDOWSIZE__II
dc.l GE_DD_D
dc.l GE_II_I
dc.l GE_LL_I
dc.l GE_RR_R
dc.l GE_TT_I
dc.l GFXSTEP_II_II
dc.l GOSUB_Z_
dc.l GOTO_Z_
dc.l GT_DD_D
dc.l GT_II_I
dc.l GT_LL_I
dc.l GT_RR_R
dc.l GT_TT_I
dc.l HEX_L_T
dc.l IF_IDD_D
dc.l IF_III_I
dc.l IF_ILL_L
dc.l IF_IRR_R
dc.l IF_ITT_T
dc.l IF_IZ_
dc.l IMP_II_I
dc.l IMP_LL_L
dc.l INKEY__T
dc.l INPUT_II_T
dc.l INPUT__
dc.l INSTR_ITT_I
dc.l INSTR_TT_I
dc.l INT_D_D
dc.l INT_R_R
dc.l KILL_T_
dc.l LEFT_TI_T
dc.l LEN_T_I
dc.l LE_DD_D
dc.l LE_II_I
dc.l LE_LL_I
dc.l LE_RR_R
dc.l LE_TT_I
dc.l LIBRARYCLOSE__
dc.l LIBRARY_T_
dc.l LINEBF_IIIII_
dc.l LINEB_IIIII_
dc.l LINEINPUT__T
dc.l LINE_IIIII_
dc.l LOCATEX_I_
dc.l LOCATEY_I_
dc.l LOC_I_L
dc.l LOF_I_L
dc.l LOG_D_D
dc.l LOG_R_R
dc.l LPOS_I_I
dc.l LPRINTRETURN__
dc.l LPRINTTAB__
dc.l LPRINT_D_
dc.l LPRINT_I_
dc.l LPRINT_L_
dc.l LPRINT_R_
dc.l LPRINT_T_
dc.l LT_DD_D
dc.l LT_II_I
dc.l LT_LL_I
dc.l LT_RR_R
dc.l LT_TT_I
dc.l MENUOFF__
dc.l MENUON__
dc.l MENURESET__
dc.l MENUSTOP__
dc.l MENU_IIIT_
dc.l MENU_III_
dc.l MENU_I_I
dc.l MID_TII_T
dc.l MID_TI_T
dc.l MKD_D_T
dc.l MKI_I_T
dc.l MKL_L_T
dc.l MKS_R_T
dc.l MOD_II_I
dc.l MOD_LL_L
dc.l MOUSEOFF__
dc.l MOUSEON__
dc.l MOUSESTOP__
dc.l MOUSE_I_I
dc.l MUL_DD_D
dc.l MUL_II_L
dc.l MUL_LL_L
dc.l MUL_RR_R
dc.l NAME_TT_
dc.l NEG_D_D
dc.l NEG_I_I
dc.l NEG_L_L
dc.l NEG_R_R
dc.l NEXT_DDDZ_
dc.l NEXT_IIIZ_
dc.l NEXT_LLLZ_
dc.l NEXT_RRRZ_
dc.l NE_DD_D
dc.l NE_II_I
dc.l NE_LL_I
dc.l NE_RR_R
dc.l NE_TT_I
dc.l NOT_I_I
dc.l NOT_L_L
dc.l OBJECT.AX_II_
dc.l OBJECT.AY_II_
dc.l OBJECT.CLIP_IIII_
dc.l OBJECT.CLOSE_I_
dc.l OBJECT.CLOSE__
dc.l OBJECT.HIT1_II_I
dc.l OBJECT.HIT2_II_I
dc.l OBJECT.OFF_I_
dc.l OBJECT.OFF__
dc.l OBJECT.ON_I_
dc.l OBJECT.ON__
dc.l OBJECT.PLANES1_II_I
dc.l OBJECT.PLANES2_II_I
dc.l OBJECT.PRIORITY_II_
dc.l OBJECT.SHAPE_II_
dc.l OBJECT.SHAPE_IT_
dc.l OBJECT.START_I_
dc.l OBJECT.START__
dc.l OBJECT.STOP_I_
dc.l OBJECT.STOP__
dc.l OBJECT.VX_II_
dc.l OBJECT.VX_I_I
dc.l OBJECT.VY_II_
dc.l OBJECT.VY_I_I
dc.l OBJECT.X_II_
dc.l OBJECT.Y_II_
dc.l OCT_L_T
dc.l ONBREAKGOSUB_Z_
dc.l ONCOLLISIONGOSUB_Z_
dc.l ONERRORGOTO_Z_
dc.l ONGOSUB_IIZ_II
dc.l ONGOTO_IIZ_II
dc.l ONMENUGOSUB_Z_
dc.l ONMOUSEGOSUB_Z_
dc.l ONTIMERGOSUB_IZ_
dc.l OPENAPPEND_TI_
dc.l OPENINPUT_TI_
dc.l OPENOUTPUT_TI_
dc.l OPENREADWRITE_TI_
dc.l OR_II_I
dc.l OR_LL_L
dc.l PAINT_IIII_
dc.l PALETTE_IRRR_
dc.l PATTERN1_L_
dc.l PATTERN2_L_
dc.l PEEKL_L_L
dc.l PEEKW_L_I
dc.l PEEK_L_I
dc.l POINT_II_I
dc.l POKEL_LL_
dc.l POKEW_LI_
dc.l POKE_LI_
dc.l POS_I_I
dc.l POT_DD_D
dc.l POT_RR_R
dc.l PRESET_III_
dc.l PRINTQMARK__
dc.l PRINTRETURN__
dc.l PRINTTAB__
dc.l PRINT_D_
dc.l PRINT_I_
dc.l PRINT_L_
dc.l PRINT_R_
dc.l PRINT_T_
dc.l PSET_III_
dc.l RANDOMIZE_I_
dc.l RANDOMIZE__
dc.l READ__T
dc.l RESTORE_I_
dc.l RESTORE__
dc.l RESUMENEXT__
dc.l RESUME_Z_
dc.l RESUME__
dc.l RETURN_Z_
dc.l RETURN__
dc.l RIGHT_TI_T
dc.l RND_I_R
dc.l RND__R
dc.l RUN_Z_
dc.l RUN__
dc.l SADD_T_L
dc.l SCREENCLOSE_I_
dc.l SCREEN_IIIII_
dc.l SCROLL_IIIIII_
dc.l SETDOUBELEM_DFP_
dc.l SETINTELEM_IFP_
dc.l SETLINE_L_
dc.l SETLONGELEM_LFP_
dc.l SETMEM_L_
dc.l SETMID_tIIT_
dc.l SETMID_tIT_
dc.l SETREALELEM_RFP_
dc.l SETSTACK_L_
dc.l SETTEXTELEM_TFP_
dc.l SGN_D_I
dc.l SGN_I_I
dc.l SGN_L_I
dc.l SGN_R_I
dc.l SIN_D_D
dc.l SIN_R_R
dc.l SLEEP__
dc.l SOUNDRESUME__
dc.l SOUNDWAIT__
dc.l SOUND_IIII_
dc.l SPACE_I_T
dc.l SQR_D_D
dc.l SQR_L_I ; Nicht mehr benutzt
dc.l SQR_R_R
dc.l STICK_I_I
dc.l STRIG_I_I
dc.l STRING_II_T
dc.l STRING_IT_T
dc.l STR_D_T
dc.l STR_I_T
dc.l STR_L_T
dc.l STR_R_T
dc.l SUB_DD_D
dc.l SUB_II_
dc.l SUB_II_I
dc.l SUB_LL_L
dc.l SUB_RR_R
dc.l SWAP_dd_
dc.l SWAP_ii_
dc.l SWAP_ll_
dc.l SWAP_rr_
dc.l SWAP_tt_
dc.l SYSTEM__
dc.l TAN_D_D
dc.l TAN_R_R
dc.l TIMEROFF__
dc.l TIMERON__
dc.l TIMERSTOP__
dc.l TIMER__L
dc.l TIME__T
dc.l TRANSLATE_T_T
dc.l TROFF__
dc.l TRON__
dc.l UCASE_T_T
dc.l VAL_T_D
dc.l WINDOWCLOSE_I_
dc.l WINDOWOUTPUT_I_
dc.l WINDOW_ITIIIIII_
dc.l WINDOW_I_L
dc.l XOR_II_I
dc.l XOR_LL_L
dc.l -1
datatable
INITBYTE LH_TYPE,NT_LIBRARY
INITLONG LN_NAME,bas_runtimeName
INITBYTE LIB_FLAGS,LIBF_SUMUSED!LIBF_CHANGED
INITWORD LIB_VERSION,VERSION
INITWORD LIB_REVISION,REVISION
INITLONG LIB_IDSTRING,idString
dc.l 0
InitLib
move.l a5,-(sp)
move.l d0,a5
move.l a0,BASBASE_SEGLIST(a5)
move.l (sp)+,a5
rts
OpenLib
addq.w #1,LIB_OPENCNT(a6)
bclr #LIBB_DELEXP,LIB_FLAGS(a6)
move.l a6,d0
rts
CloseLib
moveq #0,d0
subq.w #1,LIB_OPENCNT(a6)
bne.s StillInUse
btst #LIBB_DELEXP,LIB_FLAGS(a6)
beq.s NoDelExp
bsr ExpungeLib
NoDelExp
StillInUse
rts
ExpungeLib
movem.l d1-a6,-(sp)
tst.w LIB_OPENCNT(a6)
beq.s NoMoreUsers
bset #LIBB_DELEXP,LIB_FLAGS(a6)
moveq #0,d0
bra.s LeaveExpungeLib
NoMoreUsers
move.l a6,a5
move.l a5,a1
CallSys Remove
move.l BASBASE_SEGLIST(a5),d2
move.l a5,a1
moveq #0,d0
move.w LIB_NEGSIZE(a5),d0
sub.l d0,a1
add.w LIB_POSSIZE(a5),d0
CallSys FreeMem
move.l d2,d0
LeaveExpungeLib
movem.l (sp)+,d1-a6
rts
ExtFuncLib
moveq #0,d0
rts
EndCode
; **********************************************************************
; * *
; * Strukturen *
; * *
; **********************************************************************
; Für LINE INPUT [#]
MAXLINEINPUTLEN EQU 256
; Struktur, die zu Anfang übergeben wird
STRUCTURE STARTUP,0
WORD ST_Flags ; Flaggen - derzeit unbenutzt
WORD ST_Size ; Länge der Struktur
WORD ST_GlobalStringsSize ; A5-Speicher
WORD ST_GlobalVarsSize ; A5-Speicher
WORD ST_GlobalConstStringsSize ; A5-Speicher
LONG ST_ConstStringsPointer ; Anfang der konstanten Strings
LONG ST_DataPointer ; Anfang der DATA-Offsets (zu A5)
WORD ST_NumData ; Anzahl der DATA-Elemente
LONG ST_StringsMemSize ; Größe des Speichers für Strings
LONG ST_StackMemSize ; Stack für GOSUB/CALL
LONG ST_EndPrg ; CloseLibrary-Routine-Zeiger für Ende
LONG ST_StartPrg ; Start des Programmes
LABEL STARTUP_SIZEOF
; Struktur für ein Feld
STRUCTURE FIELD,0
LONG FIELD_NEXT ; Zeiger auf nächstes Feld (für Speicherreservierung)
LONG FIELD_TEXTPRED ; Zeiger auf vorheriges Textfeld
LONG FIELD_TEXTSUCC ; Zeiger auf nächstes Textfeld
LONG FIELD_MEM ; Zeiger auf reservierten Speicher
LONG FIELD_MEMSIZE ; Größe des Speichers
WORD FIELD_NUMDIMS ; Anzahl der Dimensionen
LABEL FIELD_FIRSTDIM ; Ab hier werden die Größen der Dimensionen abgelegt
FIELD_MINSIZE EQU FIELD_NUMDIMS
; Struktur für ein geöffnetes File
BUFFERSIZE EQU 4096
STRUCTURE FILE,0
LONG FL_NEXT ; Muß das 1. Element sein
WORD FL_NUMBER
WORD FL_ACCESSMODE
LONG FL_FILELENGTH
LONG FL_BUFFEROFFSET
LONG FL_BUFFERNUMBYTES
LONG FL_FILEPOS
LONG FL_FILEHANDLE
STRUCT FL_BUFFER,BUFFERSIZE
LABEL FL_SIZEOF
IOACCESS_INPUT EQU 1
IOACCESS_OUTPUT EQU 2
IOACCESS_READWRITE EQU 3
; Struktur für ein Fenster
STRUCTURE FENSTER,0
LONG FENSTER_NEXT
LONG FENSTER_WINDOW
LONG FENSTER_CONSOLEWRITE
WORD FENSTER_NUMBER
LONG FENSTER_TITLE
LABEL FENSTER_SIZEOF
Window_MinWidth EQU 100
Window_MinHeight EQU 50
; Der Stack wächst von unten nach oben.
; Bei STACK_GOSUB ist unter dem Typ nur die Rückkehradresse abgespeichert
; Bei STACK_SUB liegt über der SUBSTACK Struktur die Variablentabelle der
; numerischen und TEXT-Variablen, darüber liegt in einem Langwort
; die Größe des benutzten Speichers
; Bei STACK_CALL ist unter dem Typ nur die Rückkehradresse abgespeichert
;
; Stackablage-Typen:
STACK_GOSUB EQU 1
STACK_SUB EQU 2
STACK_CALL EQU 3
STRUCTURE SUBSTACK,0
LONG SUBSTACK_OLDFIRSTLOCALFIELD
LONG SUBSTACK_OLDA4
STRUCT SUBSTACK_TEXTFIELD,FIELD_MINSIZE
LABEL SUBSTACK_VARTAB
; Anzahl der Stellen von single/double-real-Variablen
IEEEDP_NumNumbers EQU 14
SP_NumNumbers EQU 7
; Alle Variable
MAXTEMP EQU 20 ; Höchstanzahl an temporären Strings
MAXRAWKEYS EQU 20 ; Soviele Zeichen werden zwischengespeichert
MAXCONSOLECHARS EQU 10 ; So lang kann ein ANSI-String höchsten sein
STRUCTURE VARS,0
STRUCT TempField,FIELD_MINSIZE ; Hieran werden alle Stringfelder gehängt
STRUCT TempMem,MAXTEMP*4
WORD TempNumber
STRUCT RawKeyBuffer,4*MAXRAWKEYS
WORD FirstRawKey
WORD LastRawKey
WORD NumRawKeys
STRUCT InputEvent,ie_SIZEOF
STRUCT ConsoleBuffer,MAXCONSOLECHARS
STRUCT GlobalStringsField,FIELD_MINSIZE ; SHARED-Stringsfeld (für GCollection)
WORD GlobalStringsSize
WORD GlobalVarsSize
WORD GlobalConstStringsSize
LONG StackMem
LONG StackMemSize
LONG StackPointer
LONG A5Mem
LONG A5MemSize
LONG MemListPointer
LONG FensterListPointer
LONG FileListPointer ; Zeiger auf erste File-Struktur
LONG StartPrg
LONG EndPrg ; Hierhin muß bei einem Abbruch gesprungen
; werden
LONG StringsMemSize ; Länge des String-Speichers
LONG StringsMem ; Adresse des String-Speichers
LONG FreeStringPointer ; Zeigt auf den nächsten freien Platz für
; Strings (auf Longword vor Länge)
LONG ThisIoError ; Nummer des IO-Error oder Null wenn keiner
LONG ThisSourceLine ; Um auch nach dem Compilieren die Nummer
; der Zeile festellten zu können, in der
; ein Fehler aufgetreten ist
LONG _ConsoleDevice ; Library-Base-Pointer
LONG _DOSBase
LONG _IntuitionBase
LONG _GfxBase
LONG _MathBase
LONG _MathTransBase
LONG _MathIeeeDoubBasBase
LONG _MathIeeeDoubTransBase
LONG CurrentMsg ; Zwischenspeicher für Messages
LABEL MousePositions ; Mauspostitions-Variable
WORD NowX
WORD NowY
WORD DownX
WORD DownY
WORD UpX
WORD UpY
WORD PressedTimes
WORD StatNow ; 0 = nicht gedrückt
LONG Seconds ; Für TIMER und DATE$ Funktionen
LONG Micros
LONG ArgLength ; CLI-Parameter
LONG ArgPointer
LONG OldSP ; Sicherung des StackPointers
LONG BasBase
LONG FileInfoBlock
BYTE InitOk ; wurde INIT__ vollständig abgearbeitet?
BYTE DoEndImm ; Darf Programm sofort abgebrochen werden?
; (0 = Ja)
BYTE StopAtNextOccasion ; Bei nächster Gelegenheit anhalten
BYTE ErrorOccured ; Ist schon ein Fehler aufgetreten?
LONG OutputFenster ; aktuelles Ausgabefenster
WORD NextData ; Nummer des nächsten zu lesenden Dataelementes
WORD NumData ; Anzahl aller Dataelemente
LONG DataPointer ; Zeiger auf erstes Dataelement
STRUCT NewWindowStruct,nw_SIZE
LONG WBMessage
LONG FirstLocalField ; Liste der lokalen Felder
LONG FirstGlobalField ; Liste der globalen Felder
STRUCT IntuiText,it_SIZEOF
STRUCT ErrorLongBuffer,20 ; für Zeilennummer
LONG TrapSeven ; für TRAPV
STRUCT DecMantisse,20 ; für STR_R_T, STR_D_T
STRUCT VALVar,8
LABEL PosSize
; **********************************************************************
; * *
; * Strings *
; * *
; **********************************************************************
BASICText MACRO
\1
dc.l *+4
dc.w \@Length
\@Start EQU *
dc.b \2
\@Length EQU *-\@Start
dc.b 0
even
ENDM
BASICText DeleteLeftText,<8," ",8>
BASICText TabText,<9>
BASICText RetText,<10>
BASICText ClsText,<12>
BASICText QMarkText,<'?'>
BASICText FilesText,<"Directory of: ">
BASICText CursorOffText,<$9b,'0 p'>
BASICText CursorOnText,<$9b,' p'>
BASICText DefaultWindowText,<'Cursor V1.0 (c) 1990 Jürgen Forster'>
LeerString
dc.l *+4,0
;BASICText LeerString,<>
DOSName
dc.b 'dos.library',0
IntuitionName
dc.b 'intuition.library',0
GfxName
dc.b 'graphics.library',0
MathName
dc.b 'mathffp.library',0
MathTransName
dc.b 'mathtrans.library',0
MathIeeeDoubBasName
dc.b 'mathieeedoubbas.library',0
MathIeeeDoubTransName
dc.b 'mathieeedoubtrans.library',0
ConsoleName
dc.b 'console.device',0
even
NullWord
dc.w 0
; **********************************************************************
; * *
; * Macros *
; * *
; **********************************************************************
Break_On MACRO
bsr TestForBreak
ENDM
Break_Off MACRO
addq.b #1,DoEndImm(a5)
ENDM
IEEEDPFieee MACRO
; CallMathIeeeDoubTrans IEEEDPFieee
; diese Funktion der IEEEDoubBas-Library hat einen Fehler
moveq #0,d1
move.l d0,a0
swap d0
beq.s \@ReturnZero
move.w d0,d1
and.l #$7f80,d0 ; Hier steht in der IEEEDoubBas-Library and.i!
asr.w #3,d0
add.w #$3800,d0
and.w #$8000,d1
or.w d1,d0
swap d0
move.l a0,d1
ror.l #3,d1
move.l d1,a0
and.l #$fffff,d1
or.l d1,d0
move.l a0,d1
and.l #$e0000000,d1
\@ReturnZero
ENDM
; **********************************************************************
; * *
; * diverse Unterroutinen *
; * *
; **********************************************************************
TestStackMem
move.l d1,-(sp)
move.l StackMem(a5),d1
add.l StackMemSize(a5),d1
sub.l StackPointer(a5),d1
cmp.l d1,d0
bgt ErrorStackOverflow
move.l (sp)+,d1
rts
; Zeiger auf Feld in a0
AddTextField
movem.l a1/a2,-(sp)
lea TempField(a5),a1
move.l a1,FIELD_TEXTPRED(a0)
move.l FIELD_TEXTSUCC(a1),a2
move.l a2,FIELD_TEXTSUCC(a0)
move.l a0,FIELD_TEXTSUCC(a1)
cmp.l #0,a2
beq.s ThereIsNoSuccessor
move.l a0,FIELD_TEXTPRED(a2)
ThereIsNoSuccessor
movem.l (sp)+,a1/a2
rts
; Zeiger auf 1. Feld in a0
FreeFieldList
move.l a2,-(sp)
move.l a0,a2
FreeFieldListLoop
cmp.l #0,a2
beq.s FreeFieldListReady
tst.l FIELD_MEM(a2)
beq.s NoFieldMemAllocated
move.l FIELD_MEM(a2),a1
bsr MyFreeMem
NoFieldMemAllocated
clr.l FIELD_MEM(a2)
clr.l FIELD_MEMSIZE(a2)
tst.l FIELD_TEXTPRED(a2)
beq.s NotInFieldList
move.l FIELD_TEXTPRED(a2),a0
move.l FIELD_TEXTSUCC(a2),FIELD_TEXTSUCC(a0)
tst.l FIELD_TEXTSUCC(a2)
beq.s NoSuccesor
move.l FIELD_TEXTSUCC(a2),a0
move.l FIELD_TEXTPRED(a2),FIELD_TEXTPRED(a0)
NoSuccesor
NotInFieldList
move.l FIELD_NEXT(a2),a2
bra.s FreeFieldListLoop
FreeFieldListReady
move.l (sp)+,a2
rts
; Zeiger auf Fenster ist in A0
OpenConsole
movem.l d1-a5,-(sp)
move.l a0,d7
moveq #0,d0
move.l d0,a0
bsr _CreatePort
tst.l d0
beq.s NoPort
move.l d0,a2
move.l a2,a0
bsr _CreateStdIO
tst.l d0
beq.s NoIO
move.l d0,a3
move.l d7,IO_DATA(a3)
move.l #wd_Size,IO_LENGTH(a3)
lea ConsoleName,a0
moveq #0,d0
move.l a3,a1
moveq #0,d1
CallSys OpenDevice
tst.l d0
bne NoConsole
move.l a3,d0
movem.l (sp)+,d1-a5
rts
NoConsole
move.l a3,a0
bsr _DeleteStdIO
NoIO
move.l a2,a0
bsr _DeletePort
NoPort
moveq #0,d0
movem.l (sp)+,d1-a5
rts
; IoStruktur in A0
CloseConsole
movem.l d0/d1/a0/a1/a2,-(sp)
move.l a0,a2
move.l a2,a1
CallSys CloseDevice
move.l MN_REPLYPORT(a2),a0
bsr _DeletePort
move.l a2,a0
bsr _DeleteStdIO
movem.l (sp)+,d0/d1/a0/a1/a2
rts
; Für die Exec-Routine RawDoFmt
RawDoFmtProc
move.b d0,(a3)+
rts
; >- d0: Divident, d1: Divisor
; -> d0: Rest, d1: Ergebnis
ULONGDiv
movem.l d2/d3,-(sp)
moveq #0,d3
moveq #31,d2
DivLoop
lsl.l #1,d0
roxl.l #1,d3
cmp.l d1,d3
blt.s NoSub
sub.l d1,d3
addq.w #1,d0
NoSub
dbra d2,DivLoop
move.l d3,d1
movem.l (sp)+,d2/d3
rts
CursorOn
pea CursorOnText
bsr PRINT_T_
rts
CursorOff
pea CursorOffText
bsr PRINT_T_
rts
; **********************************************************************
; * *
; * Speicherreservierung *
; * *
; **********************************************************************
; MyAllocMem verändert nur das Register D0, MyFreeMem gar keine
; d0/d1 wie bei AllocMem
MyAllocMem
movem.l d1/a0/a1,-(sp)
addq.l #8,d0
move.l d0,-(sp)
CallSys AllocMem
tst.l d0
beq ErrorOutOfMemory
move.l d0,a0
move.l MemListPointer(a5),(a0)
move.l d0,MemListPointer(a5)
addq.l #8,d0
move.l (sp)+,4(a0)
movem.l (sp)+,d1/a0/a1
rts
MyFreeAllMem
move.l MemListPointer(a5),a2
FreeAllLoop
cmp.l #0,a2
beq.s NoMoreMem
move.l a2,a1
move.l 4(a2),d0
move.l (a2),a2 ; Nächsten Zeiger vor FreeMem holen
CallSys FreeMem
bra.s FreeAllLoop
NoMoreMem
rts
; Zeiger auf Mem-Block in a1
MyFreeMem
movem.l d0/d1/a0/a1,-(sp)
subq.l #8,a1
lea MemListPointer(a5),a0
FreeMemLoop
tst (a0)
beq ErrorFreeMem
cmp.l (a0),a1
beq.s FoundMemBlock
move.l (a0),a0
bra.s FreeMemLoop
FoundMemBlock
move.l (a1),(a0)
move.l 4(a1),d0
CallSys FreeMem
movem.l (sp)+,d0/d1/a0/a1
rts
; **********************************************************************
; * *
; * Zeicheneingaben vom Fenster behandeln *
; * *
; **********************************************************************
; Ist d0 = 0, so wird nicht gewartet, in d0 wird das erhaltene Zeichen
; zurückgegeben, ist d0 gleich -1.l, so wurde kein Zeichen gelesen
GetOneChar
Break_Off
movem.l d1-a6,-(sp)
move.l d0,d7
GetOneCharLoop
tst.w NumRawKeys(a5)
bne.s HaveRawKey
tst.l d7
beq.s GotNoChar
moveq #1,d1
CallDOS Delay
bra.s GetOneCharLoop
GotNoChar
moveq #-1,d0
movem.l (sp)+,d1-a6
Break_On
rts
HaveRawKey
move.b #IECLASS_RAWKEY,InputEvent+ie_Class(a5)
move.w FirstRawKey(a5),d0
lsl.w #2,d0
move.w RawKeyBuffer(a5,d0.w),InputEvent+ie_Code(a5)
move.w RawKeyBuffer+2(a5,d0.w),InputEvent+ie_Qualifier(a5)
move.w FirstRawKey(a5),d0
addq.w #1,d0
cmp.w #MAXRAWKEYS,d0
bne.s NotAtEndOfRawKeys
moveq #0,d0
NotAtEndOfRawKeys
move.w d0,FirstRawKey(a5)
subq.w #1,NumRawKeys(a5)
lea InputEvent(a5),a0
lea ConsoleBuffer(a5),a1
moveq #MAXCONSOLECHARS,d1
sub.l a2,a2
CallConsole RawKeyConvert
tst.l d0
ble GetOneCharLoop
cmp.l #1,d0
beq.s ReturnOneChar
lea ConvertTable(pc),a0
tst.b (a0)
beq.s GetOneCharLoop
ConvertLoop
move.l d0,d1
lea ConsoleBuffer(a5),a1
bra.s EnterCompareLoop
CompareLoop
tst.b (a0)
beq.s NotThisString
cmp.b (a0)+,(a1)+
bne.s NotThisString
EnterCompareLoop
dbra d1,CompareLoop
tst.b (a0)+
bne.s NotThisString
moveq #0,d0
move.b (a0)+,d0
bra.s ReturnD0Char
NotThisString
tst.b (a0)+
bne.s NotThisString
addq.l #1,a0
bra.s ConvertLoop
ReturnOneChar
moveq #0,d0
move.b ConsoleBuffer(a5),d0
ReturnD0Char
movem.l (sp)+,d1-a6
Break_On
rts
ConvertTable
dc.b $9b,'Z',0,9 ; SHIFT+TAB (von Amiga-Basic nicht beachtet)
dc.b $9b,'A',0,28 ; CSRUP
dc.b $9b,'T',0,28
dc.b $9b,'B',0,29 ; DOWN
dc.b $9b,'S',0,29
dc.b $9b,'C',0,30 ; RIGHT
dc.b $9b,' @',0,30
dc.b $9b,'D',0,31 ; LEFT
dc.b $9b,' A',0,31
dc.b $9b,'?~',0,139 ; HELP
dc.b $9b,'0~',0,129 ; F1
dc.b $9b,'10~',0,129
dc.b $9b,'1~',0,130 ; F2
dc.b $9b,'11~',0,130
dc.b $9b,'2~',0,131 ; F3
dc.b $9b,'12~',0,131
dc.b $9b,'3~',0,132 ; F4
dc.b $9b,'13~',0,132
dc.b $9b,'4~',0,133 ; F5
dc.b $9b,'14~',0,133
dc.b $9b,'5~',0,134 ; F6
dc.b $9b,'15~',0,134
dc.b $9b,'6~',0,135 ; F7
dc.b $9b,'16~',0,135
dc.b $9b,'7~',0,136 ; F8
dc.b $9b,'17~',0,136
dc.b $9b,'8~',0,137 ; F9
dc.b $9b,'18~',0,137
dc.b $9b,'9~',0,138 ; F10
dc.b $9b,'19~',0,138
dc.b 0 ; Ende
even
; **********************************************************************
; * *
; * Exception/Trap behandeln *
; * *
; **********************************************************************
ExceptionCode
movem.l d0-a6,-(sp)
move.l 4,a5
move.l ThisTask(a5),a5
move.l TC_Userdata(a5),a5
move.l BasBase(a5),a6
bsr.s HandleMessages
movem.l (sp)+,d0-a6
rts
HandleMessages
lea FensterListPointer(a5),a3
HandleMessagesFensterLoop
tst.l FENSTER_NEXT(a3)
beq.s NoMoreHandleMessagesFensters
move.l FENSTER_NEXT(a3),a3
TryNextMessage
move.l FENSTER_WINDOW(a3),a0
move.l wd_UserPort(a0),a0
CallSys GetMsg
tst.l d0
beq.s NoMessageHere
move.l d0,a2
bsr.s HandleMessage
move.l a2,a1
CallSys ReplyMsg
bra.s TryNextMessage
NoMessageHere
bra.s HandleMessagesFensterLoop
NoMoreHandleMessagesFensters
rts
; Message in a2
; Fenster in a3
HandleMessage
cmp.l #CLOSEWINDOW,im_Class(a2)
beq Message_CLOSEWINDOW
cmp.l #RAWKEY,im_Class(a2)
beq Message_RAWKEY
rts
Message_CLOSEWINDOW
tst.b DoEndImm(a5)
beq.s DoEnd
move.b #1,StopAtNextOccasion(a5)
bra.s NotAtOnce
DoEnd
move.l a2,a1
CallSys ReplyMsg
bra END___NoCheck
NotAtOnce
rts
Message_RAWKEY
move.w im_Code(a2),d0
tst.b d0
bmi.s KeyUpAgain
cmp.w #MAXRAWKEYS,NumRawKeys(a5)
beq.s DontAddRawKey
move.w LastRawKey(a5),d0
lsl.w #2,d0
move.w im_Code(a2),RawKeyBuffer(a5,d0.w)
move.w im_Qualifier(a2),RawKeyBuffer+2(a5,d0.w)
move.w LastRawKey(a5),d0
addq.w #1,d0
cmp.w #MAXRAWKEYS,d0
bne.s NotRawEndReached
moveq #0,d0
NotRawEndReached
move.w d0,LastRawKey(a5)
addq.w #1,NumRawKeys(a5)
KeyUpAgain
rts
DontAddRawKey
bra BEEP__
TestForBreak
subq.b #1,DoEndImm(a5)
bne.s NotLastBreakOff
tst.b StopAtNextOccasion(a5)
beq.s WasNoBreak
bra END___NoCheck
WasNoBreak
NotLastBreakOff
rts
TrapCode
addq.l #4,sp
lea ErrorOverflow,a0
move.l a0,2(sp)
rte
; **********************************************************************
; * *
; * Öffnet alles (bricht Programm bei Fehler ab) *
; * *
; **********************************************************************
INIT__
; Zeiger auf Startup-Struktur wird in A2 übergeben und sofort ausgewertet
; In d3 ist ggf. ein Zeiger auf die Workbench-Message
; In d4/d5 sind die vorherigen D0/A0
; A5 ganz zu Anfang aufbauen
moveq #0,d0
move.w ST_GlobalStringsSize(a2),d0
add.w ST_GlobalVarsSize(a2),d0
add.w ST_GlobalConstStringsSize(a2),d0
move.l d0,d7
add.l #PosSize,d0
move.l d0,d6
move.l #MEMF_CLEAR,d1
CallSys AllocMem
tst.l d0
bne.s HaveA5Mem
addq.l #4,sp
move.l ST_EndPrg(a2),a0
moveq #0,d7
jmp (a0)
HaveA5Mem
move.l d0,a5
add.l d7,a5
move.l d0,A5Mem(a5)
move.l d6,A5MemSize(a5)
move.w ST_GlobalStringsSize(a2),GlobalStringsSize(a5)
move.w ST_GlobalVarsSize(a2),GlobalVarsSize(a5)
move.w ST_GlobalConstStringsSize(a2),GlobalConstStringsSize(a5)
move.l ST_EndPrg(a2),EndPrg(a5)
lea 4(sp),a0
move.l a0,OldSP(a5)
move.l a6,BasBase(a5)
move.l ST_StartPrg(a2),StartPrg(a5)
addq.l #4,sp
; Workbench-Message merken
move.l d3,WBMessage(a5)
;
; Libs öffnen
;
move.l 4,a0
lea DeviceList(a0),a0
lea ConsoleName(pc),a1
CallSys FindName
move.l d0,_ConsoleDevice(a5)
beq END___NoCheck
lea DOSName,a1
CallSys OldOpenLibrary
move.l d0,_DOSBase(a5)
beq END___NoCheck
lea IntuitionName,a1
CallSys OldOpenLibrary
move.l d0,_IntuitionBase(a5)
beq END___NoCheck
lea GfxName,a1
CallSys OldOpenLibrary
move.l d0,_GfxBase(a5)
beq END___NoCheck
lea MathName,a1
CallSys OldOpenLibrary
move.l d0,_MathBase(a5)
beq ErrorNoMathLibrary
lea MathTransName,a1
CallSys OldOpenLibrary
move.l d0,_MathTransBase(a5)
beq ErrorNoMathTransLibrary
lea MathIeeeDoubBasName,a1
CallSys OldOpenLibrary
move.l d0,_MathIeeeDoubBasBase(a5)
beq ErrorNoMathIeeeDoubBasLibrary
lea MathIeeeDoubTransName,a1
CallSys OldOpenLibrary
move.l d0,_MathIeeeDoubTransBase(a5)
beq ErrorNoMathIeeeDoubTransLibrary
; Baut die Zeiger auf die konstanten Strings auf
move.l ST_ConstStringsPointer(a2),a0
move.l A5Mem(a5),a1 ; Anfang der ConstStrings
move.w ST_GlobalConstStringsSize(a2),d0
lsr.w #2,d0
bra.s EnterBuildConstStringsLoop
BuildConstStringsLoop
move.l a0,(a1)+
move.w (a0),d1
addq.w #4,d1
bclr #0,d1
add.w d1,a0
EnterBuildConstStringsLoop
dbra d0,BuildConstStringsLoop
move.l ST_DataPointer(a2),DataPointer(a5)
move.w ST_NumData(a2),NumData(a5)
move.l ST_StringsMemSize(a2),d0
move.l d0,StringsMemSize(a5)
moveq #0,d1
bsr MyAllocMem
move.l d0,StringsMem(a5)
move.l ST_StackMemSize(a2),d0
move.l d0,StackMemSize(a5)
moveq #0,d1
bsr MyAllocMem
move.l d0,StackMem(a5)
move.l d0,StackPointer(a5)
; Diese müßen noch behandelt werden DEBUG
move.l d4,d0
move.l d5,a0
;
; Speicher holen
;
move.l #fib_SIZEOF,d0
moveq #0,d1
bsr MyAllocMem
move.l d0,FileInfoBlock(a5)
;
; Stringsvariable initialisieren
;
move.l StringsMem(a5),FreeStringPointer(a5)
move.l a5,a1
move.l a5,a0
sub.w GlobalStringsSize(a5),a0
bsr ClearTextField
; Tempstrings
lea TempMem(a5),a0
lea MAXTEMP*4(a0),a1
bsr ClearTextField
lea TempField(a5),a0
lea TempMem(a5),a1
move.l a1,FIELD_MEM(a0)
move.l #MAXTEMP*4,FIELD_MEMSIZE(a0)
; SHARED-Strings
move.l a5,a0
sub.w GlobalStringsSize(a5),a0
move.l a5,a1
bsr ClearTextField
lea GlobalStringsField(a5),a0
moveq #0,d0
move.w GlobalStringsSize(a5),d0
move.l d0,FIELD_MEMSIZE(a0)
neg.l d0
add.l a5,d0
move.l d0,FIELD_MEM(a0)
bsr AddTextField
moveq #7,d0
CallSys AllocTrap
move.l d0,TrapSeven(a5)
bmi ErrorNoTrapSeven
move.b #-1,InitOk(a5)
move.l 4,a0
move.l ThisTask(a0),a0
lea ExceptionCode,a1
move.l a1,TC_EXCEPTCODE(a0)
move.l a5,TC_Userdata(a0)
lea TrapCode,a1
move.l a1,TC_TRAPCODE(a0)
move.w #1,-(sp) ; Kennung
pea DefaultWindowText ; Titel
clr.w -(sp) ; x1
clr.w -(sp) ; y1
move.w #639,-(sp) ; x2
move.w #199,-(sp) ; y2
move.w #%01111,-(sp) ; Typ
move.w #1,-(sp) ; Schirm
bsr WINDOW_ITIIIIII_
move.l StartPrg(a5),-(sp)
rts
ClearTextField
move.l a2,-(sp)
lea NullWord(pc),a2
bra.s CompThem
ContClearing
move.l a2,(a0)+
CompThem
cmp.l a1,a0
bne.s ContClearing
move.l (sp)+,a2
rts
; **********************************************************************
; * *
; * Beendet das Programm *
; * *
; **********************************************************************
END__
addq.l #4,sp
cmp.l OldSP(a5),sp
bne ErrorStackTrashed
END___NoCheck
Break_Off
move.l OldSP(a5),sp
;
; Nur ausführen, wenn INIT__ erfolgreich war
;
tst.b InitOk(a5)
beq.s InitFailed
CloseFenstersLoop
move.l FensterListPointer(a5),d0
beq.s NoMoreFensters
move.l d0,a0
move.w FENSTER_NUMBER(a0),-(sp)
bsr WINDOWCLOSE_I_
bra.s CloseFenstersLoop
NoMoreFensters
bsr CLOSE__
move.b #1,DoEndImm(a5) ; Sign setzen -> Programm wird schon beendet
move.l 4,a0
move.l ThisTask(a0),a0
clr.l TC_EXCEPTCODE(a0)
clr.b StopAtNextOccasion(a5)
InitFailed
;
; Das wird bei jedem END__ abgearbeitet
;
move.l TrapSeven(a5),d0
bmi.s NoTrapSeven
CallSys FreeTrap
NoTrapSeven
tst.l _MathIeeeDoubTransBase(a5)
beq.s NoMathIeeeDoubTransBase
move.l _MathIeeeDoubTransBase(a5),a1
CallSys CloseLibrary
NoMathIeeeDoubTransBase
tst.l _MathIeeeDoubBasBase(a5)
beq.s NoMathIeeeDoubBasBase
move.l _MathIeeeDoubBasBase(a5),a1
CallSys CloseLibrary
NoMathIeeeDoubBasBase
tst.l _MathTransBase(a5)
beq.s NoMathTransBase
move.l _MathTransBase(a5),a1
CallSys CloseLibrary
NoMathTransBase
tst.l _MathBase(a5)
beq.s NoMathBase
move.l _MathBase(a5),a1
CallSys CloseLibrary
NoMathBase
tst.l _GfxBase(a5)
beq.s NoGfxBase
move.l _GfxBase(a5),a1
CallSys CloseLibrary
NoGfxBase
tst.l _IntuitionBase(a5)
beq.s NoIntuitionBase
move.l _IntuitionBase(a5),a1
CallSys CloseLibrary
NoIntuitionBase
tst.l _DOSBase(a5)
beq.s NoDOSBase
move.l _DOSBase(a5),a1
CallSys CloseLibrary
NoDOSBase
bsr MyFreeAllMem
;
; A5-Speicher freigeben und zurückspringen
;
; Workbench-Message zurückgeben
move.l WBMessage(a5),d3
move.l EndPrg(a5),a2
move.l A5Mem(a5),a1
move.l A5MemSize(a5),d0
CallSys FreeMem
moveq #0,d7
jmp (a2)
; **********************************************************************
; * *
; * Konvertierungen *
; * *
; **********************************************************************
CONVERT_D_I
movem.l (sp)+,d0/d1/d2
move.l d0,-(sp)
movem.l d1/d2,-(sp)
bsr CONVERT_D_L
bsr CONVERT_L_I
move.w (sp)+,d0
move.l (sp)+,a2
move.w d0,-(sp)
jmp (a2)
CONVERT_D_L
move.l (sp)+,a2
movem.l (sp)+,d0/d1
CallMathIeeeDoubBas IEEEDPFix
bvs ErrorOverflow
move.l d0,-(sp)
jmp (a2)
CONVERT_D_R
move.l (sp)+,a2
movem.l (sp)+,d0/d1
CallMathIeeeDoubTrans IEEEDPTieee
bvs ErrorOverflow
CallMathTrans SPFieee
bvs ErrorOverflow
move.l d0,-(sp)
jmp (a2)
CONVERT_I_D
move.l (sp)+,a2
move.w (sp)+,d0
ext.l d0
move.l d0,-(sp)
move.l a2,-(sp)
bra CONVERT_L_D
CONVERT_I_L
move.l (sp)+,a2
move.w (sp)+,d0
ext.l d0
move.l d0,-(sp)
jmp (a2)
CONVERT_I_R
move.l (sp)+,a2
move.w (sp)+,d0
ext.l d0
move.l d0,-(sp)
move.l a2,-(sp)
bra CONVERT_L_R
CONVERT_L_D
move.l (sp)+,a2
move.l (sp)+,d0
CallMathIeeeDoubBas IEEEDPFlt
movem.l d0/d1,-(sp)
jmp (a2)
CONVERT_L_I
movem.l (sp)+,a2/a3
move.l a3,d0
ext.l d0
cmp.l a3,d0
bne ErrorOverflow
move.w d0,-(sp)
jmp (a2)
CONVERT_L_R
move.l 4(sp),d0
CallMath SPFlt
move.l d0,4(sp)
rts
CONVERT_R_D
move.l (sp)+,a2
move.l (sp)+,d0
CallMathTrans SPTieee
IEEEDPFieee
movem.l d0/d1,-(sp)
jmp (a2)
CONVERT_R_I
movem.l (sp)+,d0/d1
move.l d0,-(sp)
move.l d1,-(sp)
bsr CONVERT_R_L
bsr CONVERT_L_I
move.w (sp)+,d0
move.l (sp)+,a2
move.w d0,-(sp)
jmp (a2)
CONVERT_R_L
move.l (sp)+,a2
move.l (sp)+,d0
CallMath SPFix
bvs ErrorOverflow
move.l d0,-(sp)
jmp (a2)
; **********************************************************************
; * *
; * Arithmetische Funktionen, zuerst Vergleiche *
; * *
; **********************************************************************
EQ_DD_D
move.l (sp)+,a2
movem.l (sp)+,d2/d3
movem.l (sp)+,d0/d1
CallMathIeeeDoubBas IEEEDPCmp
seq d0
ext.w d0
move.w d0,-(sp)
jmp (a2)
EQ_II_I
move.l (sp)+,a2
move.w (sp)+,d1
move.w (sp)+,d0
cmp.w d1,d0
seq d0
ext.w d0
move.w d0,-(sp)
jmp (a2)
EQ_LL_I
move.l (sp)+,a2
move.l (sp)+,d1
move.l (sp)+,d0
cmp.l d0,d1
seq d0
ext.w d0
move.w d0,-(sp)
jmp (a2)
EQ_RR_R
move.l (sp)+,a2
move.l (sp)+,d1
move.l (sp)+,d0
CallMath SPCmp
seq d0
ext.w d0
move.w d0,-(sp)
jmp (a2)
NE_DD_D
move.l (sp)+,a2
movem.l (sp)+,d2/d3
movem.l (sp)+,d0/d1
CallMathIeeeDoubBas IEEEDPCmp
sne d0
ext.w d0
move.w d0,-(sp)
jmp (a2)
NE_II_I
move.l (sp)+,a2
move.w (sp)+,d1
move.w (sp)+,d0
cmp.w d1,d0
sne d0
ext.w d0
move.w d0,-(sp)
jmp (a2)
NE_LL_I
move.l (sp)+,a2
move.l (sp)+,d1
move.l (sp)+,d0
cmp.l d0,d1
sne d0
ext.w d0
move.w d0,-(sp)
jmp (a2)
NE_RR_R
move.l (sp)+,a2
move.l (sp)+,d1
move.l (sp)+,d0
CallMath SPCmp
sne d0
ext.w d0
move.w d0,-(sp)
jmp (a2)
GT_DD_D
move.l (sp)+,a2
movem.l (sp)+,d2/d3
movem.l (sp)+,d0/d1
CallMathIeeeDoubBas IEEEDPCmp
sgt d0
ext.w d0
move.w d0,-(sp)
jmp (a2)
GT_II_I
move.l (sp)+,a2
move.w (sp)+,d1
move.w (sp)+,d0
cmp.w d1,d0
sgt d0
ext.w d0
move.w d0,-(sp)
jmp (a2)
GT_LL_I
move.l (sp)+,a2
move.l (sp)+,d1
move.l (sp)+,d0
cmp.l d0,d1
sgt d0
ext.w d0
move.w d0,-(sp)
jmp (a2)
GT_RR_R
move.l (sp)+,a2
move.l (sp)+,d1
move.l (sp)+,d0
CallMath SPCmp
sgt d0
ext.w d0
move.w d0,-(sp)
jmp (a2)
LT_DD_D
move.l (sp)+,a2
movem.l (sp)+,d2/d3
movem.l (sp)+,d0/d1
CallMathIeeeDoubBas IEEEDPCmp
slt d0
ext.w d0
move.w d0,-(sp)
jmp (a2)
LT_II_I
move.l (sp)+,a2
move.w (sp)+,d1
move.w (sp)+,d0
cmp.w d1,d0
slt d0
ext.w d0
move.w d0,-(sp)
jmp (a2)
LT_LL_I
move.l (sp)+,a2
move.l (sp)+,d1
move.l (sp)+,d0
cmp.l d0,d1
slt d0
ext.w d0
move.w d0,-(sp)
jmp (a2)
LT_RR_R
move.l (sp)+,a2
move.l (sp)+,d1
move.l (sp)+,d0
CallMath SPCmp
slt d0
ext.w d0
move.w d0,-(sp)
jmp (a2)
GE_DD_D
move.l (sp)+,a2
movem.l (sp)+,d2/d3
movem.l (sp)+,d0/d1
CallMathIeeeDoubBas IEEEDPCmp
sge d0
ext.w d0
move.w d0,-(sp)
jmp (a2)
GE_II_I
move.l (sp)+,a2
move.w (sp)+,d1
move.w (sp)+,d0
cmp.w d1,d0
sge d0
ext.w d0
move.w d0,-(sp)
jmp (a2)
GE_LL_I
move.l (sp)+,a2
move.l (sp)+,d1
move.l (sp)+,d0
cmp.l d0,d1
sge d0
ext.w d0
move.w d0,-(sp)
jmp (a2)
GE_RR_R
move.l (sp)+,a2
move.l (sp)+,d1
move.l (sp)+,d0
CallMath SPCmp
sge d0
ext.w d0
move.w d0,-(sp)
jmp (a2)
LE_DD_D
move.l (sp)+,a2
movem.l (sp)+,d2/d3
movem.l (sp)+,d0/d1
CallMathIeeeDoubBas IEEEDPCmp
sle d0
ext.w d0
move.w d0,-(sp)
jmp (a2)
LE_II_I
move.l (sp)+,a2
move.w (sp)+,d1
move.w (sp)+,d0
cmp.w d1,d0
sle d0
ext.w d0
move.w d0,-(sp)
jmp (a2)
LE_LL_I
move.l (sp)+,a2
move.l (sp)+,d1
move.l (sp)+,d0
cmp.l d0,d1
sle d0
ext.w d0
move.w d0,-(sp)
jmp (a2)
LE_RR_R
move.l (sp)+,a2
move.l (sp)+,d1
move.l (sp)+,d0
CallMath SPCmp
sle d0
ext.w d0
move.w d0,-(sp)
jmp (a2)
ABS_D_D
movem.l 4(sp),d0/d1
CallMathIeeeDoubBas IEEEDPAbs
movem.l d0/d1,4(sp)
rts
ABS_I_I
move.w 4(sp),d0
bpl.s ABS_I_I_Ok
neg.w d0
bvs ErrorOverflow
move.w d0,4(sp)
ABS_I_I_Ok
rts
ABS_L_L
move.l 4(sp),d0
bpl.s ABS_L_L_Ok
neg.l d0
bvs ErrorOverflow
move.l d0,4(sp)
ABS_L_L_Ok
rts
ABS_R_R
move.l 4(sp),d0
CallMath SPAbs
move.l d0,4(sp)
rts
ADD_DD_D
move.l (sp)+,a2
movem.l (sp)+,d0/d1/d2/d3
CallMathIeeeDoubBas IEEEDPAdd
bvs ErrorOverflow
movem.l d0/d1,-(sp)
jmp (a2)
ADD_II_I
move.l (sp)+,a2
move.w (sp)+,d0
add.w d0,(sp)
bvs ErrorOverflow
jmp (a2)
ADD_LL_L
move.l (sp)+,a2
move.l (sp)+,d0
add.l d0,(sp)
bvs ErrorOverflow
jmp (a2)
ADD_RR_R
move.l (sp)+,a2
movem.l (sp)+,d0/d1
CallMath SPAdd
bvs ErrorOverflow
move.l d0,-(sp)
jmp (a2)
AND_II_I
move.l (sp)+,a2
move.w (sp)+,d0
and.w d0,(sp)
jmp (a2)
AND_LL_L
move.l (sp)+,a2
move.l (sp)+,d0
and.l d0,(sp)
jmp (a2)
ATN_D_D
movem.l 4(sp),d0/d1
CallMathIeeeDoubTrans IEEEDPAtan
movem.l d0/d1,4(sp)
rts
ATN_R_R
move.l 4(sp),d0
CallMathTrans SPAtan
move.l d0,4(sp)
rts
COS_D_D
movem.l 4(sp),d0/d1
CallMathIeeeDoubTrans IEEEDPCos
bvs ErrorIllegalFunctionCall
movem.l d0/d1,4(sp)
rts
COS_R_R
move.l 4(sp),d0
CallMathTrans SPCos
bvs ErrorIllegalFunctionCall
move.l d0,4(sp)
rts
DIV_DD_D
move.l (sp)+,a2
movem.l (sp)+,d2/d3
movem.l (sp)+,d0/d1
CallMathIeeeDoubBas IEEEDPDiv
bvs ErrorOverflow
movem.l d0/d1,-(sp)
jmp (a2)
DIV_II_I
move.l (sp)+,a2
move.w (sp)+,d1
beq ErrorDivisionByZero
move.w (sp)+,d0
ext.l d0
divs d1,d0
bvs ErrorOverflow
move.w d0,-(sp)
jmp (a2)
DIV_LL_L
move.l (sp)+,a2
moveq #1,d7
move.l (sp)+,d1
beq ErrorDivisionByZero
bpl.s DIV_LL_L_DivisorPos
neg.l d1 ; Overflow stört nicht
moveq #-1,d7
DIV_LL_L_DivisorPos
move.l (sp)+,d0
bpl.s DIV_LL_L_DividendPos
neg.l d0
neg.l d7
DIV_LL_L_DividendPos
bsr ULONGDiv
tst.l d7
bpl.s DIV_LL_L_NoMakeNeg
neg.l d0
bvs ErrorOverflow
DIV_LL_L_NoMakeNeg
move.l d0,-(sp)
jmp (a2)
DIV_RR_R
move.l (sp)+,a2
move.l (sp)+,d1
move.l (sp)+,d0
CallMath SPDiv
bvs ErrorOverflow
move.l d0,-(sp)
jmp (a2)
EQV_II_I
move.l (sp)+,a2
move.w (sp)+,d1
move.w (sp)+,d0
eor.w d1,d0
not.w d0
move.w d0,-(sp)
jmp (a2)
EQV_LL_L
move.l (sp)+,a2
move.l (sp)+,d1
move.l (sp)+,d0
eor.l d1,d0
not.l d0
move.l d0,-(sp)
jmp (a2)
EXP_D_D
movem.l 4(sp),d0/d1
CallMathIeeeDoubTrans IEEEDPExp
bvs ErrorOverflow
movem.l d0/d1,4(sp)
rts
EXP_R_R
move.l 4(sp),d0
CallMathTrans SPExp
bvs ErrorOverflow
move.l d0,4(sp)
rts
FIX_D_D
movem.l 4(sp),d0/d1
CallMathIeeeDoubBas IEEEDPTst
bmi.s FIX_D_D_IsNeg
movem.l 4(sp),d0/d1
CallMathIeeeDoubBas IEEEDPFloor
bra.s FIX_D_D_IsPos
FIX_D_D_IsNeg
movem.l 4(sp),d0/d1
CallMathIeeeDoubBas IEEEDPCeil
FIX_D_D_IsPos
movem.l d0/d1,4(sp)
rts
FIX_R_R
move.l 4(sp),d1
CallMath SPTst
bmi.s FIX_R_R_IsNeg
move.l 4(sp),d0
CallMath SPFloor
bra.s FIX_R_R_IsPos
FIX_R_R_IsNeg
move.l 4(sp),d0
CallMath SPCeil
FIX_R_R_IsPos
move.l d0,-(sp)
rts
IMP_II_I
move.l (sp)+,a2
move.w (sp)+,d0
not.w d0
and.w (sp)+,d0
not.w d0
move.w d0,-(sp)
jmp (a2)
IMP_LL_L
move.l (sp)+,a2
move.l (sp)+,d0
not.l d0
and.l (sp)+,d0
not.l d0
move.l d0,-(sp)
jmp (a2)
INT_D_D
movem.l 4(sp),d0/d1
CallMathIeeeDoubBas IEEEDPFloor
movem.l d0/d1,4(sp)
rts
INT_R_R
move.l 4(sp),d0
CallMath SPFloor
move.l d0,4(sp)
rts
LOG_D_D
movem.l 4(sp),d0/d1
CallMathIeeeDoubTrans IEEEDPLog
bvs ErrorIllegalFunctionCall
movem.l d0/d1,4(sp)
rts
LOG_R_R
move.l 4(sp),d0
CallMathTrans SPLog
bvs ErrorIllegalFunctionCall
move.l d0,4(sp)
rts
MOD_II_I
move.l (sp)+,a2
move.w (sp)+,d1
beq ErrorDivisionByZero
move.w (sp)+,d0
ext.l d0
divs d1,d0
bvs ErrorOverflow
swap d0
move.w d0,-(sp)
jmp (a2)
MOD_LL_L
move.l (sp)+,a2
move.l (sp)+,d1
beq ErrorDivisionByZero
bpl.s MOD_LL_L_DivisorPos
neg.l d1 ; Overflow stört nicht
MOD_LL_L_DivisorPos
moveq #1,d7
move.l (sp)+,d0
bpl.s MOD_LL_L_DividendPos
neg.l d0
moveq #-1,d7
MOD_LL_L_DividendPos
bsr ULONGDiv
tst.l d7
bpl.s MOD_LL_L_NoMakeNeg
neg.l d1
bvs ErrorOverflow
MOD_LL_L_NoMakeNeg
move.l d1,-(sp)
jmp (a2)
MUL_DD_D
move.l (sp)+,a2
movem.l (sp)+,d0/d1/d2/d3
CallMathIeeeDoubBas IEEEDPMul
bvs ErrorOverflow
movem.l d0/d1,-(sp)
jmp (a2)
MUL_II_L
move.l (sp)+,a2
movem.w (sp)+,d0/d1
muls d1,d0
move.l d0,-(sp)
jmp (a2)
MUL_LL_L
move.l (sp)+,a2
moveq #1,d4
move.l (sp)+,d0
bpl.s MUL_LL_L_D0Pos
moveq #-1,d4
MUL_LL_L_D0Pos
move.l (sp)+,d1
bpl.s MUL_LL_L_D1Pos
neg.l d4
MUL_LL_L_D1Pos
moveq #0,d2
moveq #31,d3
MUL_LL_L_Loop
lsl.l #1,d2
bcs ErrorOverflow
lsl.l #1,d0
bcc.s MUL_LL_L_CNotSet
add.l d1,d2
bvs ErrorOverflow
MUL_LL_L_CNotSet
dbra d3,MUL_LL_L_Loop
tst.l d2
bmi ErrorOverflow
tst.l d4
bpl.s MUL_LL_L_IsPos
neg.l d2
MUL_LL_L_IsPos
move.l d2,-(sp)
jmp (a2)
MUL_RR_R
move.l (sp)+,a2
movem.l (sp)+,d0/d1
CallMath SPMul
bvs ErrorOverflow
move.l d0,-(sp)
jmp (a2)
NEG_D_D
movem.l 4(sp),d0/d1
CallMathIeeeDoubBas IEEEDPNeg
movem.l d0/d1,4(sp)
rts
NEG_I_I
move.w 4(sp),d0
neg.w d0
bvs ErrorOverflow
move.w d0,4(sp)
rts
NEG_L_L
move.l 4(sp),d0
neg.l d0
bvs ErrorOverflow
move.l d0,4(sp)
rts
NEG_R_R
move.l 4(sp),d0
CallMath SPNeg
move.l d0,4(sp)
rts
NOT_I_I
move.w 4(sp),d0
not.w d0
move.w d0,4(sp)
rts
NOT_L_L
move.l 4(sp),d0
not.l d0
move.l d0,4(sp)
rts
OR_II_I
move.l (sp)+,a2
move.w (sp)+,d0
or.w d0,(sp)
jmp (a2)
OR_LL_L
move.l (sp)+,a2
move.l (sp)+,d0
or.l d0,(sp)
jmp (a2)
POT_DD_D
move.l (sp)+,a2
movem.l (sp)+,d2/d3
movem.l (sp)+,d0/d1
CallMathIeeeDoubTrans IEEEDPPow
bvs ErrorOverflow
movem.l d0/d1,-(sp)
jmp (a2)
POT_RR_R
move.l (sp)+,a2
move.l (sp)+,d1
move.l (sp)+,d0
CallMathTrans SPPow
bvs ErrorOverflow
move.l d0,-(sp)
jmp (a2)
SGN_D_I
move.l (sp)+,a2
movem.l (sp)+,d0/d1
CallMathIeeeDoubBas IEEEDPTst
move.w d0,-(sp)
jmp (a2)
SGN_I_I
move.l (sp)+,a2
move.w (sp)+,d0
SGN_I_I_SetFlag
bmi.s SGN_I_I_IsNeg
beq.s SGN_I_I_IsZero
move.w #1,-(sp)
jmp (a2)
SGN_I_I_IsNeg
move.w #-1,-(sp)
jmp (a2)
SGN_I_I_IsZero
clr.w -(sp)
jmp (a2)
SGN_L_I
move.l (sp)+,a2
move.l (sp)+,d0
bra SGN_I_I_SetFlag
SGN_R_I
move.l (sp)+,a2
move.l (sp)+,d1
CallMath SPTst
move.w d0,-(sp)
jmp (a2)
SIN_D_D
movem.l 4(sp),d0/d1
CallMathIeeeDoubTrans IEEEDPSin
bvs ErrorIllegalFunctionCall
movem.l d0/d1,4(sp)
rts
SIN_R_R
move.l 4(sp),d0
CallMathTrans SPSin
bvs ErrorIllegalFunctionCall
move.l d0,4(sp)
rts
SQR_D_D
movem.l 4(sp),d0/d1
CallMathIeeeDoubTrans IEEEDPSqrt
bvs ErrorIllegalFunctionCall
movem.l d0/d1,4(sp)
rts
SQR_L_I
move.l (sp)+,a2
move.l (sp)+,d0
bmi ErrorIllegalFunctionCall
moveq #0,d1
moveq #15,d2
moveq #0,d3
SQR_L_I_Loop
lsl.l #1,d0
roxl.l #1,d1
lsl.l #1,d0
roxl.l #1,d1
lsl.l #2,d3
addq.w #1,d3
cmp.l d1,d3
bgt.s SQR_L_I_DoZero
sub.l d3,d1
addq.w #2,d3
SQR_L_I_DoZero
lsr.l #1,d3
dbra d2,SQR_L_I_Loop
move.w d3,-(sp)
jmp (a2)
SQR_R_R
move.l 4(sp),d0
CallMathTrans SPSqrt
bvs ErrorIllegalFunctionCall
move.l d0,4(sp)
rts
SUB_DD_D
move.l (sp)+,a2
movem.l (sp)+,d2/d3
movem.l (sp)+,d0/d1
CallMathIeeeDoubBas IEEEDPSub
bvs ErrorOverflow
movem.l d0/d1,-(sp)
jmp (a2)
SUB_II_I
move.l (sp)+,a2
move.w (sp)+,d0
sub.w d0,(sp)
bvs ErrorOverflow
jmp (a2)
SUB_LL_L
move.l (sp)+,a2
move.l (sp)+,d0
sub.l d0,(sp)
bvs ErrorOverflow
jmp (a2)
SUB_RR_R
move.l (sp)+,a2
move.l (sp)+,d1
move.l (sp)+,d0
CallMath SPSub
bvs ErrorOverflow
move.l d0,-(sp)
jmp (a2)
TAN_D_D
movem.l 4(sp),d0/d1
CallMathIeeeDoubTrans IEEEDPTan
bvs ErrorIllegalFunctionCall
movem.l d0/d1,4(sp)
rts
TAN_R_R
move.l 4(sp),d0
CallMathTrans SPTan
bvs ErrorIllegalFunctionCall
move.l d0,4(sp)
rts
XOR_II_I
move.l (sp)+,a2
move.w (sp)+,d0
eor.w d0,(sp)
jmp (a2)
XOR_LL_L
move.l (sp)+,a2
move.l (sp)+,d0
eor.l d0,(sp)
jmp (a2)
; **********************************************************************
; * *
; * BASIC-Funktionen *
; * *
; **********************************************************************
COLLISION_I_I
bra ErrorAdvancedFeature
CSRLIN__I
move.l (sp)+,a2
Break_Off
move.w #1,-(sp)
tst.l OutputFenster(a5)
beq.s CSRLIN__I_NoFenster
move.l OutputFenster(a5),a0
move.l FENSTER_CONSOLEWRITE(a0),a0
move.l IO_UNIT(a0),a0
move.w cu_YCCP(a0),(sp)
addq.w #1,(sp)
CSRLIN__I_NoFenster
Break_On
jmp (a2)
DATE__T
bra ErrorAdvancedFeature
ERL__I
bra ErrorAdvancedFeature
ERR__I
bra ErrorAdvancedFeature
FRE_I_L
bra ErrorAdvancedFeature
IF_IDD_D
move.l (sp)+,a2
movem.l (sp)+,d0/d1/d2/d3
tst.w (sp)+
beq IF_IDD_D_False
movem.l d2/d3,-(sp)
jmp (a2)
IF_IDD_D_False
movem.l d0/d1,-(sp)
jmp (a2)
IF_III_I
move.l (sp)+,a2
movem.w (sp)+,d0/d1
tst.w (sp)+
beq.s IF_III_I_False
move.w d1,-(sp)
jmp (a2)
IF_III_I_False
move.w d0,-(sp)
jmp (a2)
IF_ILL_L
movem.l (sp)+,a0/a1/a2
tst.w (sp)+
beq.s IF_ILL_L_False
move.l a2,-(sp)
jmp (a0)
IF_ILL_L_False
move.l a1,-(sp)
jmp (a0)
IF_IRR_R EQU IF_ILL_L
IF_ITT_T EQU IF_ILL_L
INKEY__T
move.l (sp)+,a2
moveq #0,d0
bsr GetOneChar
tst.l d0
bmi.s InkeyReturnEmptyString
move.w #1,a3
bsr CreateString
move.l a3,-(sp)
move.l (a3),a0
move.w #1,(a0)+
move.b d0,(a0)
bsr FinishString
jmp (a2)
InkeyReturnEmptyString
pea LeerString
jmp (a2)
LOC_I_L
bra ErrorAdvancedFeature
LPOS_I_I
bra ErrorAdvancedFeature
MENU_I_I
bra ErrorAdvancedFeature
MOUSE_I_I
bra ErrorAdvancedFeature
OBJECT.VX_I_I
bra ErrorAdvancedFeature
OBJECT.VY_I_I
bra ErrorAdvancedFeature
PEEKL_L_L
movem.l (sp)+,a0/a1
move.l a1,d0
btst #0,d0
bne ErrorIllegalFunctionCall
move.l (a1),-(sp)
jmp (a0)
PEEKW_L_I
movem.l (sp)+,a0/a1
move.l a1,d0
btst #0,d0
bne ErrorIllegalFunctionCall
move.w (a1),-(sp)
jmp (a0)
PEEK_L_I
movem.l (sp)+,a0/a1
move.b (a1),d0
ext.w d0
move.w d0,-(sp)
jmp (a0)
POS_I_I
Break_Off
move.w #1,4(sp)
tst.l OutputFenster(a5)
beq.s POS_I_I_NoFenster
move.l OutputFenster(a5),a0
move.l FENSTER_CONSOLEWRITE(a0),a0
move.l IO_UNIT(a0),a0
move.w cu_XCCP(a0),4(sp)
addq.w #1,4(sp)
POS_I_I_NoFenster
Break_On
rts
RND_I_R
bra ErrorAdvancedFeature
RND__R
bra ErrorAdvancedFeature
STICK_I_I
bra ErrorAdvancedFeature
STRIG_I_I
bra ErrorAdvancedFeature
TIMER__L
Break_Off
lea Seconds(a5),a0
lea Micros(a5),a1
CallIntuition CurrentTime
move.l Seconds(a5),d0
move.l #24*60*60,d1
bsr ULONGDiv
move.l (sp)+,a2
move.l d1,-(sp)
Break_On
jmp (a2)
TIME__T
bra ErrorAdvancedFeature
WINDOW_I_L
bra ErrorAdvancedFeature
; **********************************************************************
; * *
; * Einfache Funktionen zur Unterstützung der BASIC-Anweisungen/Funkt. *
; * *
; **********************************************************************
DOUBLE_D_DD
move.l (sp)+,a2
movem.l (sp),d0/d1
movem.l d0/d1,-(sp)
jmp (a2)
DOUBLE_I_II
move.l (sp)+,a2
move.w (sp),-(sp)
jmp (a2)
DOUBLE_L_LL
move.l (sp)+,a2
move.l (sp),-(sp)
jmp (a2)
DOUBLE_R_RR EQU DOUBLE_L_LL
DOUBLE_T_TT EQU DOUBLE_L_LL
FORGET_D_
move.l (sp)+,a2
addq.l #8,sp
jmp (a2)
FORGET_I_
move.l (sp)+,a2
addq.l #2,sp
jmp (a2)
FORGET_L_
move.l (sp)+,a2
addq.l #4,sp
jmp (a2)
FORGET_R_ EQU FORGET_L_
FORGET_T_ EQU FORGET_L_
; **********************************************************************
; * *
; * Alle BASIC-Befehle *
; * *
; **********************************************************************
AREAFILL_I_
bra ErrorAdvancedFeature
AREAFILL__
bra ErrorAdvancedFeature
AREA_II_
bra ErrorAdvancedFeature
BEEP__
Break_Off
sub.l a0,a0
CallIntuition DisplayBeep
Break_On
rts
BREAKOFF__
bra ErrorAdvancedFeature
BREAKON__
bra ErrorAdvancedFeature
BREAKSTOP__
bra ErrorAdvancedFeature
CALL_Z_
moveq #6,d0
bsr TestStackMem
move.l StackPointer(a5),a3
move.l (sp)+,(a3)+
move.w #STACK_CALL,(a3)+
move.l a3,StackPointer(a5)
rts
CHECKINPUTEND__
bra ErrorAdvancedFeature
CIRCLE_IIIIRRR_
bra ErrorAdvancedFeature
CIRCLE_IIIIRR_
bra ErrorAdvancedFeature
CIRCLE_IIII_
bra ErrorAdvancedFeature
CIRCLE_III_
bra ErrorAdvancedFeature
CLEAR__
bra ErrorAdvancedFeature
CLS__
Break_Off
tst.l OutputFenster(a5)
beq.s CLS___NoFenster
moveq #0,d0
move.l OutputFenster(a5),a1
move.l FENSTER_WINDOW(a1),a1
move.l wd_RPort(a1),a1
CallGfx SetRast
move.w #1,-(sp)
bsr LOCATEX_I_
move.w #1,-(sp)
bsr LOCATEY_I_
CLS___NoFenster
Break_On
rts
COLLISIONOFF__
bra ErrorAdvancedFeature
COLLISIONON__
bra ErrorAdvancedFeature
COLLISIONSTOP__
bra ErrorAdvancedFeature
COLOR1_I_
bra ErrorAdvancedFeature
COLOR2_I_
bra ErrorAdvancedFeature
SUB_II_
; Stackbereich berechnen und testen
moveq #SUBSTACK_VARTAB,d0
add.w 4(sp),d0
move.l d0,d7 ; Zeiger auf Stringsvars
add.l StackPointer(a5),d7
add.w 6(sp),d0
addq.l #6,d0 ; +STACK_SUB+Größe des benutzten Speichers
bsr TestStackMem
; StackPointer holen und verändern
move.l StackPointer(a5),a3
add.l d0,StackPointer(a5)
; ganz nach oben die Größe des Speichers
move.l d0,-6(a3,d0.l)
move.w #STACK_SUB,-2(a3,d0.l)
; SUBSTACK-Struktur füllen
move.l FirstLocalField(a5),(a3)+ ; SUBSTACK_OLDFIRSTLOCALFIELD
move.l a4,(a3)+ ; SUBSTACK_OLDA4
move.l a3,a0
clr.l (a3)+ ; FIELD_NEXT
clr.l (a3)+ ; FIELD_TEXTPRED
clr.l (a3)+ ; FIELD_TEXTSUCC
move.l d7,(a3)+ ; FIELD_MEM
clr.w (a3)+ ; FIELD_MEMSIZE
move.w 6(sp),(a3)+
bsr AddTextField
move.w 4(sp),d1
bra.s SUB_II__EnterClearNumVarsLoop
SUB_II__ClearNumVarsLoop
clr.b (a3)+
SUB_II__EnterClearNumVarsLoop
dbra d1,SUB_II__ClearNumVarsLoop
move.w 6(sp),d1
lsr.w #2,d1
lea NullWord(pc),a0
bra.s SUB_II__EnterClearTextVarsLoop
SUB_II__ClearTextVarsLoop
move.l a0,(a3)+
SUB_II__EnterClearTextVarsLoop
dbra d1,SUB_II__ClearTextVarsLoop
; a4 neu setzen
move.l a3,a4
; Fertig
move.l (sp)+,a2
addq.l #4,sp
jmp (a2)
ENDSUB__
move.l StackPointer(a5),a3
ENDSUB___SkipReturnsLoop
cmp.w #STACK_SUB,-2(a3)
beq.s ENDSUB___FoundStackSub
subq.l #6,a3
bra.s ENDSUB___SkipReturnsLoop
ENDSUB___FoundStackSub
move.l -6(a3),d0
sub.l d0,a3
move.l SUBSTACK_OLDFIRSTLOCALFIELD(a3),FirstLocalField(a5)
move.l SUBSTACK_OLDA4(a3),a4
lea SUBSTACK_TEXTFIELD(a3),a0
clr.l FIELD_MEM(a0)
clr.l FIELD_MEMSIZE(a0)
bsr FreeFieldList
subq.l #2,a3
move.l -(a3),(sp)
move.l a3,StackPointer(a5)
rts
ERASE_f_
bra ErrorAdvancedFeature
ERROR_L_
bra ErrorAdvancedFeature
EXITSUB__
bra ErrorAdvancedFeature
FRONTCOLOR__I
bra ErrorAdvancedFeature
GETCOLOR0__I
bra ErrorAdvancedFeature
GETINPUTPART__T
bra ErrorAdvancedFeature
GETWINDOWSIZE__II
bra ErrorAdvancedFeature
GFXSTEP_II_II
bra ErrorAdvancedFeature
GOSUB_Z_
moveq #6,d0
bsr TestStackMem
move.l StackPointer(a5),a3
move.l (sp)+,(a3)+
move.w #STACK_GOSUB,(a3)+
move.l a3,StackPointer(a5)
rts
GOTO_Z_
addq.l #4,sp
rts
IF_IZ_
movem.l (sp)+,a0/a1
tst.w (sp)+
beq.s IF_IZ__False
jmp (a0)
IF_IZ__False
jmp (a1)
INPUT__
bra ErrorAdvancedFeature
LIBRARYCLOSE__
bra ErrorAdvancedFeature
LIBRARY_T_
bra ErrorAdvancedFeature
LINEBF_IIIII_
bra ErrorAdvancedFeature
LINEB_IIIII_
bra ErrorAdvancedFeature
LINEINPUT__T
bsr CursorOn
move.w #MAXLINEINPUTLEN,a3
bsr CreateString
move.l (sp)+,a2
move.l a3,-(sp)
move.l a2,-(sp)
move.l (a3),a0
move.l a0,a1
clr.w (a1)+
LINEINPUT__T_Loop
moveq #-1,d0
bsr GetOneChar
cmp.b #13,d0
beq.s LINEINPUT__T_EndOfLineInput
cmp.b #8,d0
bne.s LINEINPUT__T_NoBackSpace ; BackSpace
tst.w (a0)
beq.s LINEINPUT__T_Loop
subq.w #1,(a0)
subq.l #1,a1
movem.l a0/a1,-(sp)
pea DeleteLeftText
bsr PRINT_T_
movem.l (sp)+,a0/a1
bra.s LINEINPUT__T_Loop
LINEINPUT__T_NoBackSpace
move.b d0,d1
and.b #$7f,d1 ; SteuerCode?
cmp.b #$20,d1
blt.s LINEINPUT__T_Loop
move.w (a0),d1
cmp.w #MAXLINEINPUTLEN,d1
bhi.s LINEINPUT__T_Loop
move.b d0,(a1)+
addq.w #1,(a0)
movem.l a0/a1,-(sp)
lsl.w #8,d0
move.w d0,-(sp)
move.w #1,-(sp)
move.l sp,-(sp)
move.l sp,-(sp)
bsr PRINT_T_
addq.l #8,sp
movem.l (sp)+,a0/a1
bra LINEINPUT__T_Loop
LINEINPUT__T_EndOfLineInput
bsr FinishString
bsr CursorOff
bra PRINTRETURN__
LINE_IIIII_
bra ErrorAdvancedFeature
LOCATEX_I_
bsr CSRLIN__I
move.w (sp)+,d1
move.l (sp)+,a2
move.w d1,-(sp)
move.l a2,-(sp)
bra LOCATEXY_II_
LOCATEY_I_
clr.w -(sp)
bsr POS_I_I
move.w (sp)+,d0
move.l (sp)+,a2
move.w (sp)+,d1
move.w d0,-(sp)
move.w d1,-(sp)
move.l a2,-(sp)
bra LOCATEXY_II_
LOCATEXY_II_
move.l FreeStringPointer(a5),a3
move.l a3,a1
move.l (sp)+,a2
move.l (sp)+,(a3)+
move.l a2,-(sp)
addq.l #4,a3
move.l a3,-4(a3)
pea -4(a3)
addq.l #2,a3
lea LOCATEY_I_FormatString,a0
lea RawDoFmtProc,a2
CallSys RawDoFmt
move.l (sp),a0
move.l (a0),a0
move.l a0,a1
move.w #-1,(a1)+
LOCATEY_I_Loop
addq.w #1,(a0)
tst.b (a1)+
bne.s LOCATEY_I_Loop
bsr PRINT_T_
rts
LOCATEY_I_FormatString
dc.b $9b,"%d;%dH",0
even
LPRINTRETURN__
bra ErrorAdvancedFeature
LPRINTTAB__
bra ErrorAdvancedFeature
LPRINT_D_
bra ErrorAdvancedFeature
LPRINT_I_
bra ErrorAdvancedFeature
LPRINT_L_
bra ErrorAdvancedFeature
LPRINT_R_
bra ErrorAdvancedFeature
LPRINT_T_
bra ErrorAdvancedFeature
MENUOFF__
bra ErrorAdvancedFeature
MENUON__
bra ErrorAdvancedFeature
MENURESET__
bra ErrorAdvancedFeature
MENUSTOP__
bra ErrorAdvancedFeature
MENU_IIIT_
bra ErrorAdvancedFeature
MENU_III_
bra ErrorAdvancedFeature
MOUSEOFF__
bra ErrorAdvancedFeature
MOUSEON__
bra ErrorAdvancedFeature
MOUSESTOP__
bra ErrorAdvancedFeature
NEXT_DDDZ_
movem.l (sp)+,a2/a3
movem.l (sp)+,d0/d1/d2/d3/d4/d5
CallMathIeeeDoubBas IEEEDPTst
beq.s NEXT_DDDZ_DoLoop
bmi.s NEXT_DDDZ_IsNeg
move.l d4,d0
move.l d5,d1
CallMathIeeeDoubBas IEEEDPCmp
bgt.s NEXT_DDDZ_LeaveLoop
jmp (a3)
NEXT_DDDZ_IsNeg
move.l d4,d0
move.l d5,d1
CallMathIeeeDoubBas IEEEDPCmp
bge.s NEXT_DDDZ_DoLoop
NEXT_DDDZ_LeaveLoop
jmp (a2)
NEXT_DDDZ_DoLoop
jmp (a3)
NEXT_IIIZ_
movem.l (sp)+,a2/a3
movem.w (sp)+,d0/d1/d2
tst.w d0
beq.s NEXT_IIIZ_DoLoop
bmi.s NEXT_IIIZ_IsNeg
cmp.w d1,d2
bgt.s NEXT_IIIZ_LeaveLoop
jmp (a3)
NEXT_IIIZ_IsNeg
cmp.w d1,d2
bge.s NEXT_IIIZ_DoLoop
NEXT_IIIZ_LeaveLoop
jmp (a2)
NEXT_IIIZ_DoLoop
jmp (a3)
NEXT_LLLZ_
movem.l (sp)+,a2/a3
movem.l (sp)+,d0/d1/d2
tst.l d0
beq.s NEXT_LLLZ_DoLoop
bmi.s NEXT_LLLZ_IsNeg
cmp.l d1,d2
bgt.s NEXT_LLLZ_LeaveLoop
jmp (a3)
NEXT_LLLZ_IsNeg
cmp.l d1,d2
bge.s NEXT_LLLZ_DoLoop
NEXT_LLLZ_LeaveLoop
jmp (a2)
NEXT_LLLZ_DoLoop
jmp (a3)
NEXT_RRRZ_
movem.l (sp)+,a2/a3
movem.l (sp)+,d1/d2/d3
CallMath SPTst
beq.s NEXT_RRRZ_DoLoop
bmi.s NEXT_RRRZ_IsNeg
move.l d3,d0
move.l d2,d1
CallMath SPCmp
bgt.s NEXT_RRRZ_LeaveLoop
jmp (a3)
NEXT_RRRZ_IsNeg
move.l d3,d0
move.l d2,d1
CallMath SPCmp
bge.s NEXT_RRRZ_DoLoop
NEXT_RRRZ_LeaveLoop
jmp (a2)
NEXT_RRRZ_DoLoop
jmp (a3)
OBJECT.AX_II_
bra ErrorAdvancedFeature
OBJECT.AY_II_
bra ErrorAdvancedFeature
OBJECT.CLIP_IIII_
bra ErrorAdvancedFeature
OBJECT.CLOSE__
bra ErrorAdvancedFeature
OBJECT.CLOSE_I_
bra ErrorAdvancedFeature
OBJECT.HIT1_II_I
bra ErrorAdvancedFeature
OBJECT.HIT2_II_I
bra ErrorAdvancedFeature
OBJECT.OFF_I_
bra ErrorAdvancedFeature
OBJECT.OFF__
bra ErrorAdvancedFeature
OBJECT.ON_I_
bra ErrorAdvancedFeature
OBJECT.ON__
bra ErrorAdvancedFeature
OBJECT.PLANES1_II_I
bra ErrorAdvancedFeature
OBJECT.PLANES2_II_I
bra ErrorAdvancedFeature
OBJECT.PRIORITY_II_
bra ErrorAdvancedFeature
OBJECT.SHAPE_II_
bra ErrorAdvancedFeature
OBJECT.SHAPE_IT_
bra ErrorAdvancedFeature
OBJECT.START__
bra ErrorAdvancedFeature
OBJECT.START_I_
bra ErrorAdvancedFeature
OBJECT.STOP__
bra ErrorAdvancedFeature
OBJECT.STOP_I_
bra ErrorAdvancedFeature
OBJECT.VX_II_
bra ErrorAdvancedFeature
OBJECT.VY_II_
bra ErrorAdvancedFeature
OBJECT.X_II_
bra ErrorAdvancedFeature
OBJECT.Y_II_
bra ErrorAdvancedFeature
ONBREAKGOSUB_Z_
bra ErrorAdvancedFeature
ONCOLLISIONGOSUB_Z_
bra ErrorAdvancedFeature
ONERRORGOTO_Z_
bra ErrorAdvancedFeature
ONGOSUB_IIZ_II
move.l (sp)+,a2
move.l (sp)+,a3
move.w (sp),d0
bmi ErrorIllegalFunctionCall
addq.w #1,2(sp)
cmp.w 2(sp),d0
beq.s ON_GOSUB_IIZ_II_DoGosub
jmp (a2)
ON_GOSUB_IIZ_II_DoGosub
moveq #6,d0
bsr TestStackMem
move.l StackPointer(a5),a0
move.l a2,(a0)+
move.w #STACK_GOSUB,(a0)+
move.l a0,StackPointer(a5)
jmp (a3)
ONGOTO_IIZ_II
move.l (sp)+,a2
move.l (sp)+,a3
move.w (sp),d0
bmi ErrorIllegalFunctionCall
addq.w #1,2(sp)
cmp.w 2(sp),d0
beq.s ON_GOTO_IIZ_II_DoGoto
jmp (a2)
ON_GOTO_IIZ_II_DoGoto
addq.l #4,sp
jmp (a3)
ONMENUGOSUB_Z_
bra ErrorAdvancedFeature
ONMOUSEGOSUB_Z_
bra ErrorAdvancedFeature
ONTIMERGOSUB_IZ_
bra ErrorAdvancedFeature
PAINT_IIII_
bra ErrorAdvancedFeature
PALETTE_IRRR_
bra ErrorAdvancedFeature
PATTERN1_L_
bra ErrorAdvancedFeature
PATTERN2_L_
bra ErrorAdvancedFeature
POINT_II_I
bra ErrorAdvancedFeature
POKEL_LL_
move.l (sp)+,a2
move.l (sp)+,d0
move.l (sp)+,a0
move.l a0,d1
btst #0,d1
bne ErrorIllegalFunctionCall
move.l d0,(a0)
jmp (a2)
POKEW_LI_
move.l (sp)+,a2
move.w (sp)+,d0
move.l (sp)+,a0
move.l a0,d1
btst #0,d1
bne ErrorIllegalFunctionCall
move.w d0,(a0)
jmp (a2)
POKE_LI_
move.l (sp)+,a2
move.w (sp)+,d0
move.l (sp)+,a0
move.b d0,(a0)
jmp (a2)
PRESET_III_
bra ErrorAdvancedFeature
PRINTQMARK__
pea QMarkText
bsr PRINT_T_
rts
PRINTRETURN__
pea RetText
bsr PRINT_T_
rts
PRINTTAB__
pea TabText
bsr PRINT_T_
rts
PRINT_D_
move.l (sp)+,a2
movem.l (sp)+,d0/d1
movem.l d0/d1/a2,-(sp)
bsr STR_D_T
bsr PRINT_T_
rts
PRINT_I_
move.l (sp)+,a2
move.w (sp)+,d0
ext.l d0
move.l d0,-(sp)
move.l a2,-(sp)
bra PRINT_L_
PRINT_L_
move.l (sp)+,a2
move.l (sp)+,d0
move.l a2,-(sp)
move.l d0,-(sp)
bsr STR_L_T
bsr PRINT_T_
rts
PRINT_R_
move.l (sp)+,a2
move.l (sp)+,d0
move.l a2,-(sp)
move.l d0,-(sp)
bsr STR_R_T
bsr PRINT_T_
rts
PRINT_T_
move.l (sp)+,a2
Break_Off
tst.l OutputFenster(a5)
beq.s PRINT_T__NoFenster
move.l OutputFenster(a5),a1
move.l FENSTER_CONSOLEWRITE(a1),a1
move.l (sp)+,a0
move.l (a0),a0
moveq #0,d0
move.w (a0)+,d0
move.l d0,IO_LENGTH(a1)
move.l a0,IO_DATA(a1)
move.w #CMD_WRITE,IO_COMMAND(a1)
CallSys DoIO
PRINT_T__NoFenster
Break_On
jmp (a2)
PSET_III_
bra ErrorAdvancedFeature
RANDOMIZE_I_
bra ErrorAdvancedFeature
RANDOMIZE__
bra ErrorAdvancedFeature
READ__T
move.l (sp)+,a2
move.w NextData(a5),d0
cmp.w NumData(a5),d0
bhi ErrorOutOfData
addq.w #1,NextData(a5)
lsl.w #1,d0
move.l DataPointer(a5),a0
move.w 0(a0,d0.w),d0
pea 0(a5,d0.w)
jmp (a2)
RESTORE_I_
move.l (sp)+,a2
move.w (sp)+,NextData(a5)
jmp (a2)
RESTORE__
clr.w NextData(a5)
rts
RESUMENEXT__
bra ErrorAdvancedFeature
RESUME_Z_
bra ErrorAdvancedFeature
RESUME__
bra ErrorAdvancedFeature
RETURN_Z_
move.l StackPointer(a5),a0
cmp.l StackMem(a5),a0
beq ErrorReturnWithoutGosub
cmp.w #STACK_GOSUB,-(a0)
bne ErrorReturnWithoutGosub
subq.l #4,a0
move.l a0,StackPointer(a5)
addq.l #4,sp
rts
RETURN__
move.l StackPointer(a5),a0
cmp.l StackMem(a5),a0
beq ErrorReturnWithoutGosub
cmp.w #STACK_GOSUB,-(a0)
bne ErrorReturnWithoutGosub
move.l -(a0),(sp)
move.l a0,StackPointer(a5)
rts
RUN_Z_
bra ErrorAdvancedFeature
RUN__
bra ErrorAdvancedFeature
SCREENCLOSE_I_
bra ErrorAdvancedFeature
SCREEN_IIIII_
bra ErrorAdvancedFeature
SCROLL_IIIIII_
bra ErrorAdvancedFeature
; So läßt sich bei einem Fehler-Abbruch die aktuelle Sourcecode-Zeile
; feststellen, allerdings muß diese Routine vom Hauptprogramm immer
; dann aufgerufen werden, wenn eine neue BASIC-Zeile Übersetzt wird.
SETLINE_L_
move.l (sp)+,a2
move.l (sp)+,ThisSourceLine(a5)
cmp.l OldSP(a5),sp
bne ErrorStackTrashed
jmp (a2)
SETMEM_L_
bra ErrorAdvancedFeature
SETSTACK_L_
bra ErrorAdvancedFeature
SLEEP__
bra ErrorAdvancedFeature
SOUNDRESUME__
bra ErrorAdvancedFeature
SOUNDWAIT__
bra ErrorAdvancedFeature
SOUND_IIII_
bra ErrorAdvancedFeature
SWAP_dd_
movem.l (sp)+,a0/a1/a2
movem.l (a1),d0/d1
movem.l (a2),d2/d3
movem.l d2/d3,(a1)
movem.l d0/d1,(a2)
jmp (a0)
SWAP_ii_
movem.l (sp)+,a0/a1/a2
move.w (a1),d0
move.w (a2),(a1)
move.w d0,(a2)
jmp (a0)
SWAP_ll_
movem.l (sp)+,a0/a1/a2
move.l (a1),d0
move.l (a2),(a1)
move.l d0,(a1)
jmp (a0)
SWAP_rr_
movem.l (sp)+,a0/a1/a2
move.l (a1),d0
move.l (a2),(a1)
move.l d0,(a1)
jmp (a0)
SWAP_tt_
movem.l (sp)+,a0/a1/a2
move.l (a1),d0
move.l (a2),(a1)
move.l d0,(a1)
jmp (a0)
SYSTEM__ EQU END__
TIMEROFF__
bra ErrorAdvancedFeature
TIMERON__
bra ErrorAdvancedFeature
TIMERSTOP__
bra ErrorAdvancedFeature
TRANSLATE_T_T
bra ErrorAdvancedFeature
TROFF__
bra ErrorAdvancedFeature
TRON__
bra ErrorAdvancedFeature
WINDOWCLOSE_I_
move.l (sp)+,a2
CallSys Forbid
move.w (sp)+,d0
lea FensterListPointer(a5),a3
WINDOWCLOSE_I__SearchLoop
move.l a3,a0
tst.l (a0)
beq ErrorIllegalFunctionCall
move.l (a0),a3
cmp.w FENSTER_NUMBER(a3),d0
bne.s WINDOWCLOSE_I__SearchLoop
move.l (a3),(a0)
cmp.l OutputFenster(a5),a3
beq.s WINDOWCLOSE_I__NotTheOutputFenster
clr.l OutputFenster(a5)
WINDOWCLOSE_I__NotTheOutputFenster
move.l FENSTER_CONSOLEWRITE(a3),a0
bsr CloseConsole
move.l FENSTER_WINDOW(a3),a0
CallIntuition CloseWindow
move.l FENSTER_TITLE(a3),a1
bsr MyFreeMem
move.l a3,a1
bsr MyFreeMem
CallSys Permit
jmp (a2)
WINDOWOUTPUT_I_
bra ErrorAdvancedFeature
WINDOW_ITIIIIII_
Break_Off
; Speicher für Fensterstruktur reservieren
moveq #FENSTER_SIZEOF,d0
moveq #0,d1
bsr MyAllocMem
move.l d0,a3
; Werte vom Stack lesen und auswerten
lea NewWindowStruct(a5),a0
; Rückkehradresse
move.l (sp)+,a2
; Screen
addq.l #2,sp ; überlesen DEBUG
move.w #WBENCHSCREEN,nw_Type(a0)
clr.l nw_Screen(a0)
; Typ
move.w (sp)+,d0
move.l #ACTIVATE|GIMMEZEROZERO,d1
btst #0,d0
beq.s NoWindowSizing
or.l #WINDOWSIZING|SIZEBRIGHT,d1
NoWindowSizing
btst #1,d0
beq.s NoWindowDrag
or.l #WINDOWDRAG,d1
NoWindowDrag
btst #2,d0
beq.s NoWindowDepth
or.l #WINDOWDEPTH,d1
NoWindowDepth
btst #3,d0
beq.s NoWindowClose
or.l #WINDOWCLOSE,d1
NoWindowClose
btst #4,d0
beq.s NoSuperBitMap
or.l #SUPER_BITMAP,d1
NoSuperBitMap
move.l d1,nw_Flags(a0)
move.l #CLOSEWINDOW|MOUSEBUTTONS|RAWKEY,nw_IDCMPFlags(a0)
; Koordinaten
move.w (sp)+,d3
move.w (sp)+,d2
move.w (sp)+,d1
move.w (sp)+,d0
sub.w d0,d2
addq.w #1,d2
cmp.w #Window_MinWidth,d2
blt ErrorIllegalFunctionCall
sub.w d1,d3
addq.w #1,d3
cmp.w #Window_MinHeight,d3
blt ErrorIllegalFunctionCall
move.w d0,nw_LeftEdge(a0)
move.w d1,nw_TopEdge(a0)
move.w d2,nw_Width(a0)
move.w d3,nw_Height(a0)
; Pens
move.b #-1,nw_DetailPen(a0)
move.b #-1,nw_BlockPen(a0)
; FirstGadget ist immer Null
; CheckMark ist immer Null
move.l (sp)+,a1
move.l (a1),a1
moveq #0,d0
move.w (a1),d0
addq.w #1,d0
moveq #0,d1
bsr MyAllocMem
move.l d0,FENSTER_TITLE(a3)
move.l d0,nw_Title(a0)
move.l a0,-(sp)
move.l d0,a0
move.w (a1)+,d0
WindowTitleLoop
move.b (a1)+,(a0)+
dbra d0,WindowTitleLoop
move.l (sp)+,a0
; Bitmap
clr.l nw_BitMap(a0)
move.w #Window_MinWidth,nw_MinWidth(a0)
move.w #Window_MinHeight,nw_MinHeight(a0)
move.w #-1,nw_MaxWidth(a0)
move.w #-1,nw_MaxHeight(a0)
move.w (sp)+,FENSTER_NUMBER(a3)
; Das Fenster wirklich öffnen
CallIntuition OpenWindow
move.l d0,FENSTER_WINDOW(a3)
beq ErrorCannotOpenWindow
move.l d0,a0
bsr OpenConsole
tst.l d0
beq GotNoConsole
move.l d0,FENSTER_CONSOLEWRITE(a3)
move.l a3,OutputFenster(a5)
move.l FensterListPointer(a5),FENSTER_NEXT(a3)
move.l a3,FensterListPointer(a5)
; Exception-Flag setzen
move.l FENSTER_WINDOW(a3),a0
move.l wd_UserPort(a0),a0
move.b MP_SIGBIT(a0),d2
moveq #0,d0
bset d2,d0
move.l d0,d1
CallSys SetExcept
Break_On
move.l a2,-(sp)
bra CursorOff
GotNoConsole
move.l FENSTER_WINDOW(a3),a0
CallIntuition CloseWindow
bra ErrorCouldNotOpenConsole
; **********************************************************************
; * *
; * Stringfunktionen *
; * *
; **********************************************************************
ADD_TT_T
move.l (sp)+,a2
move.l (sp)+,a1
move.l (sp)+,a0
move.l (a0),a0
move.l (a1),a1
move.w (a0)+,d0
move.w (a1)+,d1
move.w d0,d2
add.w d1,d2
move.w d2,a3
bsr CreateString
move.l a3,-(sp)
move.l a2,-(sp)
move.l (a3),a3
move.w d2,(a3)+
bsr.s ADD_TT_T_EnterLoop
move.l a1,a0
move.w d1,d0
bsr.s ADD_TT_T_EnterLoop
bra FinishString
ADD_TT_T_Loop
move.b (a0)+,(a3)+
ADD_TT_T_EnterLoop
dbra d0,ADD_TT_T_Loop
rts
ASC_T_I
movem.l (sp)+,a0/a1
move.l (a1),a1
tst.w (a1)+
beq ErrorIllegalFunctionCall
moveq #0,d0
move.b (a1),d0
move.w d0,-(sp)
jmp (a0)
CHR_I_T
move.w #1,a3
bsr CreateString
move.l (sp)+,a0
move.w (sp)+,d0
bmi ErrorIllegalFunctionCall
cmp.w #256,d0
bge ErrorIllegalFunctionCall
move.l a3,-(sp)
move.l (a3),a1
move.w #1,(a1)+
move.b d0,(a1)
move.l a0,-(sp)
bra FinishString
CVD_T_D
move.l (sp)+,a2
move.l (sp)+,a0
move.l (a0),a0
cmp.w #8,(a0)+
blt ErrorIllegalFunctionCall
movem.l (a0),d0/d1
movem.l d0/d1,-(sp)
jmp (a2)
CVI_T_I
move.l (sp)+,a2
move.l (sp)+,a0
move.l (a0),a0
cmp.w #2,(a0)+
blt ErrorIllegalFunctionCall
move.w (a0),-(sp)
jmp (a2)
CVL_T_L
move.l (sp)+,a2
move.l (sp)+,a0
move.l (a0),a0
cmp.w #4,(a0)+
blt ErrorIllegalFunctionCall
move.l (a0),-(sp)
jmp (a2)
CVL_T_R EQU CVL_T_L
EQ_TT_I
movem.l (sp)+,a0/a1/a2
move.l (a1),a1
move.l (a2),a2
move.w (a1)+,d0
cmp.w (a2)+,d0
bne.s EQ_TT_I_False
bra.s EQ_TT_I_EnterLoop
EQ_TT_I_Loop
cmpm.b (a1)+,(a2)+
bne.s EQ_TT_I_False
EQ_TT_I_EnterLoop
dbra d0,EQ_TT_I_Loop
move.w #-1,-(sp)
jmp (a0)
EQ_TT_I_False
clr.w -(sp)
jmp (a0)
GE_TT_I
moveq #3,d7
bra CompareStrings
GT_TT_I
moveq #1,d7
bra CompareStrings
HEX_L_T
move.w #8,a3
bsr CreateString
move.l 4(sp),d0
move.l a3,4(sp)
move.l (a3),a0
move.w #8,(a0)+
moveq #7,d1
lea HexTable,a1
moveq #0,d2
HEX_L_T_Loop
rol.l #4,d0
move.b d0,d2
and.b #$f,d2
move.b 0(a1,d2.w),(a0)+
dbra d1,HEX_L_T_Loop
bra FinishString
HexTable
dc.b "0123456789ABCDEF"
even
; d0: verbleibende Versuche
; d1: Länge String2
; d2: ggf. richtiges Ergebnis
; a0: Rest von String1
; a1: Anfang von String2
INSTR_ITT_I
move.l (sp)+,a2
move.l (sp)+,a1
move.l (a1),a1
move.l (sp)+,a0
move.l (a0),a0
move.w (sp)+,d2
ble ErrorIllegalFunctionCall
move.w (a0)+,d0
beq.s INSTR_ITT_I_0
move.w (a1)+,d1
beq.s INSTR_ITT_I_1
sub.w d2,d0
sub.w d1,d0
addq.w #2,d0
bmi INSTR_ITT_I_0
lea -1(a0,d2.w),a0
bra.s INSTR_ITT_I_EnterLoop
INSTR_ITT_I_Loop
move.w d1,d5
move.l a0,d6
move.l a1,d7
bra.s INSTR_ITT_I_EnterCompLoop
INSTR_ITT_I_CompLoop
cmpm.b (a0)+,(a1)+
bne.s INSTR_ITT_I_NotFound
INSTR_ITT_I_EnterCompLoop
dbra d5,INSTR_ITT_I_CompLoop
bra.s INSTR_ITT_I_D2
INSTR_ITT_I_NotFound
move.l d6,a0
move.l d7,a1
addq.l #1,a0
addq.w #1,d2
INSTR_ITT_I_EnterLoop
dbra d0,INSTR_ITT_I_Loop
INSTR_ITT_I_0
clr.w -(sp)
jmp (a2)
INSTR_ITT_I_D2
move.w d2,-(sp)
jmp (a2)
INSTR_ITT_I_1
move.w #1,-(sp)
jmp (a2)
INSTR_TT_I
movem.l (sp)+,a0/a1/a2
move.w #1,-(sp)
movem.l a0/a1/a2,-(sp)
bra INSTR_ITT_I
LEFT_TI_T
move.l (sp)+,a2
move.w (sp)+,d0
bmi ErrorIllegalFunctionCall
move.w #1,-(sp)
move.w d0,-(sp)
move.l a2,-(sp)
bra MID_TII_T
LEN_T_I
movem.l (sp)+,a0/a1
move.l (a1),a1
move.w (a1),-(sp)
jmp (a0)
LE_TT_I
moveq #6,d7
bra CompareStrings
LT_TT_I
moveq #4,d7
bra CompareStrings
MID_TII_T
move.l (sp)+,a2
move.w (sp)+,d1
bmi ErrorIllegalFunctionCall
move.w (sp)+,d0
ble ErrorIllegalFunctionCall
move.l (sp)+,a0
move.l (a0),a0
move.w (a0)+,d2
subq.w #1,d0
lea 0(a0,d0.w),a0
sub.w d0,d2
cmp.w d2,d1
ble MID_TII_T_NotTooLong
move.w d2,d1
MID_TII_T_NotTooLong
tst.w d1
ble MID_TII_T_ReturnEmptyString
move.w d1,a3
bsr CreateString
move.l a3,-(sp)
move.l (a3),a1
move.w d1,(a1)+
bra.s MID_TII_T_EnterLoop
MID_TII_T_Loop
move.b (a0)+,(a1)+
MID_TII_T_EnterLoop
dbra d1,MID_TII_T_Loop
bsr FinishString
jmp (a2)
MID_TII_T_ReturnEmptyString
pea LeerString
jmp (a2)
MID_TI_T
move.l (sp)+,a2
move.w #$7fff,-(sp)
move.l a2,-(sp)
bra MID_TII_T
MKD_D_T
move.w #8,a3
bsr CreateString
move.l (sp)+,a2
movem.l (sp)+,d0/d1
move.l a3,-(sp)
move.l (a3),a0
move.w #8,(a0)+
movem.l d0/d1,(a0)
bsr FinishString
jmp (a2)
MKI_I_T
move.w #2,a3
bsr CreateString
move.l (sp)+,a2
move.w (sp)+,d0
move.l a3,-(sp)
move.l (a3),a0
move.w #2,(a0)+
move.w d0,(a0)
bsr FinishString
jmp (a2)
MKL_L_T
move.w #4,a3
bsr CreateString
move.l (a3),a0
move.w #4,(a0)+
move.l 4(sp),(a0)
move.l a3,4(sp)
bra FinishString
MKS_R_T EQU MKL_L_T
NE_TT_I
movem.l (sp)+,a0/a1/a2
move.l (a1),a1
move.l (a2),a2
move.w (a1)+,d0
cmp.w (a2)+,d0
bne.s NE_TT_I_True
bra.s NE_TT_I_EnterLoop
NE_TT_I_Loop
cmpm.b (a1)+,(a2)+
bne.s NE_TT_I_True
NE_TT_I_EnterLoop
dbra d0,NE_TT_I_Loop
clr.w -(sp)
jmp (a0)
NE_TT_I_True
move.w #-1,-(sp)
jmp (a0)
OCT_L_T
bra ErrorAdvancedFeature
RIGHT_TI_T
move.l (sp)+,a2
move.w (sp)+,d0
bmi ErrorIllegalFunctionCall
move.l (sp),a0
move.l (a0),a0
cmp.w (a0),d0
ble.s RIGHT_TI_T_NoCutString
move.w (a0),d0
RIGHT_TI_T_NoCutString
move.w (a0),d1
sub.w d0,d1
addq.w #1,d1
move.w d1,-(sp)
move.w d0,-(sp)
move.l a2,-(sp)
bra MID_TII_T
SADD_T_L
move.l 4(sp),a0
move.l (a0),a0
addq.l #2,a0
move.l a0,4(sp)
rts
SETMID_tIIT_
bra ErrorAdvancedFeature
SETMID_tIT_
bra ErrorAdvancedFeature
SPACE_I_T
move.l (sp)+,a2
move.w (sp)+,d0
move.w d0,a3
bsr CreateString
move.l a3,-(sp)
move.l a2,-(sp)
move.l (a3),a3
move.w d0,(a3)+
bra.s SPACE_I_T_EnterLoop
SPACE_I_T_Loop
move.b #' ',(a3)+
SPACE_I_T_EnterLoop
dbra d0,SPACE_I_T_Loop
bra FinishString
STRING_II_T
move.l (sp)+,a2
move.w (sp)+,d0
bmi ErrorIllegalFunctionCall
cmp.w #256,d0
bge ErrorIllegalFunctionCall
bra Enter_STRING_IT_T
STRING_IT_T
move.l (sp)+,a2
move.l (sp)+,a0
move.l (a0),a0
tst.w (a0)+
beq ErrorIllegalFunctionCall
move.b (a0),d0
Enter_STRING_IT_T
move.w (sp)+,d1
move.w d1,a3
bsr CreateString
move.l a3,-(sp)
move.l a2,-(sp)
move.l (a3),a3
move.w d1,(a3)+
bra.s STRING_IT_T_EnterLoop
STRING_IT_T_Loop
move.b d0,(a3)+
STRING_IT_T_EnterLoop
dbra d1,STRING_IT_T_Loop
bra FinishString
STR_D_T
move.l (sp)+,a2
moveq #IEEEDP_NumNumbers,d5 ; Stellenzahl
movem.l (sp)+,d6/d7
STR_D_T_EnterMe
; String zum Ablegen erzeugen
move.w #100,a3
bsr CreateString
move.l a3,-(sp)
move.l a2,-(sp)
move.l (a3),a3
move.l a3,a2
clr.w (a3)+
; Zahl gleich Null, positiv oder negativ?
move.l d6,d0
move.l d7,d1
CallMathIeeeDoubBas IEEEDPTst
beq STR_D_T_ReturnZero
bpl.s STR_D_T_IsPositive
move.b #'-',(a3)+
move.l d6,d0
move.l d7,d1
CallMathIeeeDoubBas IEEEDPAbs
move.l d0,d6
move.l d1,d7
bra.s STR_D_T_IsNegative
STR_D_T_IsPositive
move.b #' ',(a3)+
STR_D_T_IsNegative
; Zehnerexponent isolieren
move.l d6,d0
move.l d7,d1
CallMathIeeeDoubTrans IEEEDPLog10
CallMathIeeeDoubBas IEEEDPFloor
move.l d0,-(sp)
move.l d1,-(sp)
CallMathIeeeDoubBas IEEEDPFix
move.l d0,d4 ; Exponent
move.l #$40240000,d0 ; 10 im IEEEDP-Format
moveq #0,d1
move.l (sp)+,d3
move.l (sp)+,d2
CallMathIeeeDoubTrans IEEEDPPow
move.l d0,d2
move.l d1,d3
move.l d6,d0
move.l d7,d1
CallMathIeeeDoubBas IEEEDPDiv
move.l d0,d6
move.l d1,d7
; Zehnerexponent in d4
; Stellenzahl in d5
; Zahl in d6/d7 (Vorzeichen ist behandelt, Zahl ist ungleich 0)
move.l a2,-(sp)
movem.l d6/d7,VALVar(a5)
move.l d5,d6
lea DecMantisse(a5),a2
clr.b (a2)+
STR_D_T_CreateNumbersLoop
movem.l VALVar(a5),d0/d1
CallMathIeeeDoubBas IEEEDPFloor
move.l d0,-(sp)
move.l d1,-(sp)
CallMathIeeeDoubBas IEEEDPFix
move.b d0,(a2)+
movem.l VALVar(a5),d0/d1
move.l (sp)+,d3
move.l (sp)+,d2
CallMathIeeeDoubBas IEEEDPSub
move.l #$40240000,d2 ; 10 im IEEEDP-Format
moveq #0,d3
CallMathIeeeDoubBas IEEEDPMul
movem.l d0/d1,VALVar(a5)
dbra d6,STR_D_T_CreateNumbersLoop
; runden
cmp.b #5,-(a2)
blt.s STR_D_T_NoRoundUp
addq.b #1,-1(a2)
STR_D_T_NoRoundUp
move.l d5,d6
bra.s STR_D_T_EnterRoundLoop
STR_D_T_RoundLoop
cmp.b #10,-(a2)
blt.s STR_D_T_NotGreaterNine
sub.b #10,(a2)
addq.b #1,-1(a2)
STR_D_T_NotGreaterNine
STR_D_T_EnterRoundLoop
dbra d6,STR_D_T_RoundLoop
move.l (sp)+,a2
; a0 zeigt auf erstes Zeichen der Mantisse, a1 hinter das letzte
lea DecMantisse+1(a5),a0
lea 0(a0,d5),a1
tst.b -1(a0)
beq.s STR_D_T_NoOverflow
subq.l #1,a0
subq.l #1,a1
addq.l #1,d4
STR_D_T_NoOverflow
STR_D_T_RemoveZerosLoop
tst.b -1(a1)
bne.s STR_D_T_NoMoreZeros
subq.l #1,a1
cmp.l a0,a1
beq STR_D_T_ReturnZero
bra.s STR_D_T_RemoveZerosLoop
STR_D_T_NoMoreZeros
; Position des Kommas feststellen
moveq #1,d6
cmp.l d5,d4
bge.s STR_D_T_DoExp
move.l d5,d7
neg.l d7
cmp.l d7,d4
ble.s STR_D_T_DoExp
add.l d4,d6
moveq #0,d4
STR_D_T_DoExp
; Zahl in den String schreiben
tst.l d6 ; führende Nullen ausgeben
bgt.s STR_D_T_NoFrontZeros
move.b #'.',(a3)+
STR_D_T_FrontZerosLoop
addq.l #1,d6
bgt.s STR_D_T_NoMoreFrontZeros
move.b #'0',(a3)+
bra.s STR_D_T_FrontZerosLoop
STR_D_T_NoMoreFrontZeros
subq.l #2,d6
STR_D_T_NoFrontZeros
STR_D_T_Output1Loop ; Zahlen ausgeben
cmp.l a0,a1
beq.s STR_D_T_NoMoreNumbers
tst.l d6
bne.s STR_D_T_NoPutPoint
move.b #'.',(a3)+
STR_D_T_NoPutPoint
subq.l #1,d6
move.b (a0)+,d0
add.b #'0',d0
move.b d0,(a3)+
bra.s STR_D_T_Output1Loop
STR_D_T_NoMoreNumbers
tst.l d6 ; Nullen am Ende ausgeben
ble.s STR_D_T_Output1Finished
move.b #'0',(a3)+
subq.l #1,d6
bra.s STR_D_T_NoMoreNumbers
STR_D_T_Output1Finished
; Exponent ggf. ausgeben
clr.b (a3)
tst.l d4
beq.s STR_D_T_NoExponentOutput
cmp.l #IEEEDP_NumNumbers,d5
beq.s STR_D_T_OutPutD
move.b #'E',(a3)+
bra.s STR_D_T_OutPutE
STR_D_T_OutPutD
move.b #'D',(a3)+
STR_D_T_OutPutE
tst.l d4
bmi.s STR_D_T_ExpNegative
move.b #'+',(a3)+
STR_D_T_ExpNegative
move.l a2,-(sp)
lea STR_D_T_FormatString,a0
move.l FreeStringPointer(a5),a1
move.l d4,(a1)
lea RawDoFmtProc,a2
CallSys RawDoFmt
move.l (sp)+,a2
STR_D_T_NoExponentOutput
; Stringlänge berechnen
move.l a2,a3
move.w #-1,(a3)+
STR_D_T_GetStringLen
addq.w #1,(a2)
tst.b (a3)+
bne.s STR_D_T_GetStringLen
bra FinishString
STR_D_T_ReturnZero
move.w #' 0',(a3)+
move.w #2,(a2)
bra FinishString
STR_D_T_FormatString
dc.b "%ld",0
even
STR_I_T
move.l (sp)+,a2
move.w (sp)+,d0
ext.l d0
move.l d0,-(sp)
move.l a2,-(sp)
bra STR_L_T
STR_L_T_String
dc.b " %ld",0
even
STR_L_T
Break_Off
move.w #20,a3
bsr CreateString
move.l a3,d7
lea STR_L_T_String,a0
lea 4(sp),a1
tst.l (a1)
bpl.s STR_L_T_UseSpace
addq.l #1,a0
STR_L_T_UseSpace
lea RawDoFmtProc,a2
move.l (a3),a3
addq.l #2,a3
CallSys RawDoFmt
move.l d7,4(sp)
move.l d7,a0
move.l (a0),a0
move.l a0,a1
clr.w (a1)+
STR_L_T_TestStringLenght
tst.b (a1)+
beq.s STR_L_T_EndOfNewStringReached
addq.w #1,(a0)
bra.s STR_L_T_TestStringLenght
STR_L_T_EndOfNewStringReached
bsr FinishString
Break_On
rts
STR_R_T
move.l (sp)+,a2
move.l (sp)+,d0
CallMathTrans SPTieee
IEEEDPFieee
moveq #SP_NumNumbers,d5 ; Stellenzahl
move.l d0,d6
move.l d1,d7
bra STR_D_T_EnterMe
UCASE_T_T
move.l 4(sp),a0
move.l (a0),a0
move.w (a0)+,d0
move.w d0,a3
bsr CreateString
move.l a3,4(sp)
move.l (a3),a1
move.w d0,(a1)+
bra.s UCASE_T_T_EnterLoop
UCASE_T_T_Loop
move.b (a0)+,d1
cmp.b #'a',d1
blt.s UCASE_T_T_NotToUpper
cmp.b #'z',d1
bgt.s UCASE_T_T_NotToUpper
and.b #$df,d1
UCASE_T_T_NotToUpper
move.b d1,(a1)+
UCASE_T_T_EnterLoop
dbra d0,UCASE_T_T_Loop
bra FinishString
VAL_T_D
move.l (sp)+,a2
move.l (sp)+,a0
move.l (a0),a0
move.w (a0)+,d0
bsr VAL_T_D_SkipSpaces
; Vorzeichen
moveq #0,d3
tst.w d0
beq.s VAL_T_D_NoMinus
cmp.b #'-',(a0)
bne.s VAL_T_D_NoMinus
moveq #-1,d3
subq.w #1,d0
addq.l #1,a0
VAL_T_D_NoMinus
; Mantisse auslesen
moveq #0,d4 ; 64 Bit Mantisse
moveq #0,d5
moveq #0,d6 ; Noch keinen Dezimalpunkt gefunden
moveq #0,d7 ; Zehnerexponent
VAL_T_D_Pass1Loop
tst.w d0
beq VAL_T_D_Pass1Finished
move.b (a0)+,d1
subq.w #1,d0
cmp.b #'.',d1
beq VAL_T_D_FoundPoint
cmp.b #'E',d1
beq VAL_T_D_FoundExponent
cmp.b #'e',d1
beq VAL_T_D_FoundExponent
cmp.b #'D',d1
beq VAL_T_D_FoundExponent
cmp.b #'d',d1
beq VAL_T_D_FoundExponent
cmp.b #'0',d1
blt VAL_T_D_Pass1Finished
cmp.b #'9',d1
bgt VAL_T_D_Pass1Finished
sub.b #'0',d1
ext.w d1
ext.l d1
; Paßt noch etwas in die Mantisse hinein?
; $0de0b6b3a7640000 10^18
; $8ac7230489e80000 10^19
cmp.l #$0de0b6b3,d4
bhi VAL_T_D_MantisseFull
bne.s VAL_T_D_MantisseNotFull
cmp.l #$a7640000,d5
bhi VAL_T_D_MantisseFull
VAL_T_D_MantisseNotFull
; auf Punkt achten
tst.l d6
beq.s VAL_T_D_NoPointYet
subq.l #1,d7
VAL_T_D_NoPointYet
; d4/d5 verzehnfachen
movem.l d6/d7,-(sp)
add.l d5,d5
addx.l d4,d4
move.l d5,d7
move.l d4,d6
add.l d5,d5
addx.l d4,d4
add.l d5,d5
addx.l d4,d4
add.l d7,d5
addx.l d6,d4
movem.l (sp)+,d6/d7
; d1 dazu
add.l d1,d5
bcc.s VAL_T_D_CarryClear
addq.l #1,d4
VAL_T_D_CarryClear
bra VAL_T_D_Pass1Loop
; Dezimalpunkt gefunden
VAL_T_D_FoundPoint
not.l d6
beq VAL_T_D_Pass1Finished
bra VAL_T_D_Pass1Loop
; Kein Platz mehr in der Mantisse
VAL_T_D_MantisseFull
tst.l d6
bne VAL_T_D_Pass1Loop
addq.l #1,d7
bra VAL_T_D_Pass1Loop
;
; Exponent auswerten
;
; d2 kommt zum Zehnerexponenten noch dazu
VAL_T_D_FoundExponent
; Vorzeichen des Exponenten
moveq #1,d6
tst.w d0
beq.s VAL_T_D_ExponentNotPlusOrMinus
cmp.b #'-',(a0)
bne.s VAL_T_D_ExponentNotMinus
moveq #-1,d6
subq.w #1,d0
addq.l #1,a0
bra.s VAL_T_D_ExponentWasMinus
VAL_T_D_ExponentNotMinus
cmp.b #'+',(a0)
bne.s VAL_T_D_ExponentNotPlusOrMinus
subq.w #1,d0
addq.l #1,a0
VAL_T_D_ExponentWasMinus
VAL_T_D_ExponentNotPlusOrMinus
; Exponent selber auslesen
moveq #0,d2
VAL_T_D_ExponentLoop
subq.w #1,d0
bmi.s VAL_T_D_NoMoreExponentChars
move.b (a0)+,d1
sub.b #'0',d1
bmi.s VAL_T_D_NoMoreExponentChars
cmp.b #10,d1
bge.s VAL_T_D_NoMoreExponentChars
move.l d1,-(sp)
add.l d2,d2
move.l d2,d1
add.l d2,d2
add.l d2,d2
add.l d1,d2
add.l (sp)+,d2
cmp.l #10000,d2
bgt ErrorOverflow
bra.s VAL_T_D_ExponentLoop
VAL_T_D_NoMoreExponentChars
muls d6,d2
add.l d2,d7
;
; in Double-Zahl wandeln
;
VAL_T_D_Pass1Finished
; Vorzeichen in d3, Mantisse in d4/d5, Zehnerexponent in d7
; Ist das Ergebnis 0?
tst.l d4
bne.s VAL_T_D_NotZero
tst.l d5
beq VAL_T_D_ReturnZero
VAL_T_D_NotZero
; ggf. nach rechts schieben
move.l #$43300000,d0
VAL_T_D_ShiftRightLoop1
cmp.l #$003fffff,d4
bls.s VAL_T_D_LeaveShiftRightLoop1
add.l #$00100000,d0
lsr.l #1,d5
lsr.l #1,d4
bcc.s VAL_T_D_ShiftRightLoop1
bset #31,d5
bra.s VAL_T_D_ShiftRightLoop1
VAL_T_D_LeaveShiftRightLoop1
; ggf. nach links schieben
VAL_T_D_ShiftLeftLoop
btst #21,d4
bne.s VAL_T_D_LeaveShiftLeftLoop
sub.l #$00100000,d0
lsl.l #1,d4
lsl.l #1,d5
bcc.s VAL_T_D_ShiftLeftLoop
bset #0,d4
bra.s VAL_T_D_ShiftLeftLoop
VAL_T_D_LeaveShiftLeftLoop
; Aufrunden
addq.l #1,d5
bcc.s VAL_T_D_NoRoundOverflow
addq.l #1,d4
VAL_T_D_NoRoundOverflow
; Nochmal nach rechts schieben
VAL_T_D_ShiftRightLoop2
cmp.l #$001fffff,d4
bls.s VAL_T_D_LeaveShiftRightLoop2
add.l #$00100000,d0
lsr.l #1,d5
lsr.l #1,d4
bcc.s VAL_T_D_ShiftRightLoop2
bset #31,d5
bra.s VAL_T_D_ShiftRightLoop2
VAL_T_D_LeaveShiftRightLoop2
; fertig mit Schieben
bclr #20,d4
or.l d0,d4
tst.l d3
beq.s VAL_T_D_NotNegativ
bset #31,d4
VAL_T_D_NotNegativ
; Zehnerexponenten berücksichtigen
move.l d7,d0
CallMathIeeeDoubBas IEEEDPFlt
move.l d0,d2
move.l d1,d3
move.l #$40240000,d0 ; 10 im IEEEDP-Format
moveq #0,d1
CallMathIeeeDoubTrans IEEEDPPow
bvs ErrorOverflow
move.l d4,d2
move.l d5,d3
CallMathIeeeDoubBas IEEEDPMul
bvs ErrorOverflow
movem.l d0/d1,-(sp)
jmp (a2)
VAL_T_D_ReturnZero
clr.l -(sp)
clr.l -(sp)
jmp (a2)
VAL_T_D_SkipSpaces
tst.w d0
beq.s VAL_T_D_NoMoreSpaces
cmp.b #' ',(a0)
bne.s VAL_T_D_NoMoreSpaces
addq.l #1,a0
subq.w #1,d0
bra.s VAL_T_D_SkipSpaces
VAL_T_D_NoMoreSpaces
rts
; d7:
; Bit 0: Darf String 1 größer sein?
; Bit 1: Dürfen die Strings identisch sein?
; Bit 2: Darf String 2 größer sein?
CompareStrings
move.l (sp)+,a2
move.l (sp)+,a1
move.l (sp)+,a0
move.l (a0),a0
move.l (a1),a1
move.w (a0)+,d0
move.w (a1)+,d1
NoDecisionMade
tst.w d0
beq.s String1Empty
tst.w d1
beq.s String1IsGreater
subq.w #1,d0
subq.w #1,d1
cmpm.b (a0)+,(a1)+
beq.s NoDecisionMade
bhi.s String2IsGreater
String1IsGreater
moveq #1,d0
bra.s LeaveCompareStrings
String2IsGreater
moveq #4,d0
bra.s LeaveCompareStrings
String1Empty
tst.w d1
bne.s String2IsGreater
moveq #2,d0 ; Die Strings sind identisch
LeaveCompareStrings
and.l d7,d0
bne.s CompStringsTrue
clr.w -(sp)
jmp (a2)
CompStringsTrue
move.w #-1,-(sp)
jmp (a2)
; **********************************************************************
; * *
; * I/O-Basicanweisungen *
; * *
; **********************************************************************
CHDIR_T_
Break_Off
move.l (sp)+,a2
move.l (sp)+,a0
move.l (a0),a0
addq.l #2,a0
bsr LockIt
move.l d0,d1
CallDOS CurrentDir
move.l d0,d1
CallDOS UnLock
Break_On
jmp (a2)
CLOSE__
move.l FileListPointer(a5),d0
beq.s NoMoreFiles
move.l d0,a0
move.w FL_NUMBER(a0),-(sp)
bsr CLOSE_I_
bra.s CLOSE__
NoMoreFiles
rts
CLOSE_I_
move.l (sp)+,a2
Break_Off
move.w (sp)+,d0
bsr ReallyFindFileStruct
; Aus der Liste entfernen
lea FileListPointer(a5),a0
CLOSE_I__Loop
cmp.l FL_NEXT(a0),a3
beq.s CLOSE_I__FoundIt
move.l FL_NEXT(a0),a0
bra.s CLOSE_I__Loop
CLOSE_I__FoundIt
move.l FL_NEXT(a3),FL_NEXT(a0)
; ggf. noch schreiben
cmp.w #IOACCESS_OUTPUT,FL_ACCESSMODE(a3)
bne.s CLOSE_I__NoOutputFile
move.l FL_BUFFERNUMBYTES(a3),d3
beq.s CLOSE_I__BufferEmpty
lea FL_BUFFER(a3),a0
move.l a0,d2
move.l FL_FILEHANDLE(a3),d1
CallDOS Write
tst.b ErrorOccured(a5)
bne.s CLOSE_I__DontCareForError
tst.l d0
bmi ErrorIO
CLOSE_I__DontCareForError
CLOSE_I__BufferEmpty
CLOSE_I__NoOutputFile
; File schließen
move.l FL_FILEHANDLE(a3),d1
CallDOS Close
; Speicher freigeben
move.l a3,a1
bsr MyFreeMem
; fertig
Break_On
jmp (a2)
EOF_I_I
move.w 4(sp),d0
bsr ReallyFindFileStruct
cmp.w #IOACCESS_INPUT,FL_ACCESSMODE(a3)
bne ErrorBadFileMode
move.l FL_FILEPOS(a3),d0
sub.l FL_BUFFERNUMBYTES(a3),d0
cmp.l FL_FILELENGTH(a3),d0
seq d0
ext.w d0
move.w d0,4(sp)
rts
FILEINPUT_I_IT
bra ErrorAdvancedFeature
FILELINEINPUT_I_T
Break_Off
move.l (sp)+,d7
move.w (sp)+,d0
bsr ReallyFindFileStruct
cmp.w #IOACCESS_INPUT,FL_ACCESSMODE(a3)
bne ErrorBadFileMode
move.l FL_FILEPOS(a3),d0
sub.l FL_BUFFERNUMBYTES(a3),d0
cmp.l FL_FILELENGTH(a3),d0
beq ErrorInputPastEnd
move.l a3,d6
move.w #MAXLINEINPUTLEN,a3
bsr CreateString
move.l a3,-(sp)
move.l (a3),a0
move.l a0,a1
clr.w (a1)+
move.l d6,a3
move.l d7,-(sp)
FILELINEINPUT_I_T_AddToString
lea FL_BUFFER(a3),a2
add.l FL_BUFFEROFFSET(a3),a2
move.l FL_BUFFERNUMBYTES(a3),d0
bra.s FILELINEINPUT_I_T_EnterLoop
FILELINEINPUT_I_T_Loop
move.b (a2)+,d1
addq.l #1,FL_BUFFEROFFSET(a3)
subq.l #1,FL_BUFFERNUMBYTES(a3)
cmp.b #10,d1
beq.s FILELINEINPUT_I_T_ReachedEnd
cmp.w #MAXLINEINPUTLEN,(a0)
beq ErrorStringTooLong
move.b d1,(a1)+
addq.w #1,(a0)
FILELINEINPUT_I_T_EnterLoop
dbra d0,FILELINEINPUT_I_T_Loop
move.l FL_FILELENGTH(a3),d0
sub.l FL_FILEPOS(a3),d0
ble.s FILELINEINPUT_I_T_ReachedEnd
cmp.l #BUFFERSIZE,d0
ble.s FILELINEINPUT_I_T_D0Ok
move.l #BUFFERSIZE,d0
FILELINEINPUT_I_T_D0Ok
clr.l FL_BUFFEROFFSET(a3)
move.l d0,FL_BUFFERNUMBYTES(a3)
add.l d0,FL_FILEPOS(a3)
move.l FL_FILEHANDLE(a3),d1
pea FL_BUFFER(a3)
move.l (sp)+,d2
move.l d0,d3
movem.l a0/a1,-(sp)
CallDOS Read
movem.l (sp)+,a0/a1
tst.l d0
bmi ErrorIO
bra.s FILELINEINPUT_I_T_AddToString
FILELINEINPUT_I_T_ReachedEnd
Break_On
bra FinishString
FILEPRINTRETURN_I_I
move.l (sp)+,a2
pea RetText
move.l a2,-(sp)
bra FILEPRINT_IT_I
FILEPRINTTAB_I_I
move.l (sp)+,a2
pea TabText
move.l a2,-(sp)
bra FILEPRINT_IT_I
FILEPRINT_ID_I
move.l (sp)+,a2
movem.l (sp)+,d0/d1
move.w (sp)+,d2
move.l a2,-(sp)
move.w d2,-(sp)
movem.l d0/d1,-(sp)
bsr STR_D_T
bsr FILEPRINT_IT_I
move.w (sp)+,d0
move.l (sp)+,a2
move.w d0,-(sp)
jmp (a2)
FILEPRINT_II_I
move.l (sp)+,a2
move.w (sp)+,d0
move.w (sp)+,d1
move.l a2,-(sp)
move.w d1,-(sp)
move.w d0,-(sp)
bsr STR_I_T
bsr FILEPRINT_IT_I
move.w (sp)+,d0
move.l (sp)+,a2
move.w d0,-(sp)
jmp (a2)
FILEPRINT_IL_I
move.l (sp)+,a2
move.l (sp)+,d0
move.w (sp)+,d1
move.l a2,-(sp)
move.w d1,-(sp)
move.l d0,-(sp)
bsr STR_L_T
bsr FILEPRINT_IT_I
move.w (sp)+,d0
move.l (sp)+,a2
move.w d0,-(sp)
jmp (a2)
FILEPRINT_IR_I
move.l (sp)+,a2
move.l (sp)+,d0
move.w (sp)+,d1
move.l a2,-(sp)
move.w d1,-(sp)
move.l d0,-(sp)
bsr STR_R_T
bsr FILEPRINT_IT_I
move.w (sp)+,d0
move.l (sp)+,a2
move.w d0,-(sp)
jmp (a2)
FILEPRINT_IT_I
Break_Off
move.l (sp)+,a2
move.l (sp)+,a0
move.l (a0),a0
moveq #0,d3
move.w (a0)+,d3
move.l a0,d2
move.w (sp),d0
bsr ReallyFindFileStruct
cmp.w #IOACCESS_OUTPUT,FL_ACCESSMODE(a3)
bne ErrorBadFileMode
add.l d3,FL_FILELENGTH(a3)
add.l d3,FL_FILEPOS(a3)
; Puffer benutzen?
cmp.l #BUFFERSIZE,d3
blt.s FILEPRINT_IT_I_BufferIt
; Puffer nicht benutzen, zuerst aber ausgeben
tst.l FL_BUFFERNUMBYTES(a3)
beq.s FILEPRINT_IT_I_BufferEmpty
move.l d2,-(sp)
move.l d3,-(sp)
lea FL_BUFFER(a3),a0
move.l a0,d2
move.l FL_BUFFERNUMBYTES(a3),d3
clr.l FL_BUFFERNUMBYTES(a3)
move.l FL_FILEHANDLE(a3),d1
CallDOS Write
tst.l d0
bmi ErrorIO
move.l (sp)+,d3
move.l (sp)+,d2
FILEPRINT_IT_I_BufferEmpty
move.l FL_FILEHANDLE(a3),d1
CallDOS Write
tst.l d0
bmi ErrorIO
Break_On
jmp (a2)
FILEPRINT_IT_I_BufferIt
FILEPRINT_IT_I_BufferLoop
; Anzahl der in den Puffer zu schreibenden Bytes bestimmen
move.l #BUFFERSIZE,d4
sub.l FL_BUFFERNUMBYTES(a3),d4
bne.s FILEPRINT_IT_I_BufferNotFull
move.l d2,-(sp)
move.l d3,-(sp)
clr.l FL_BUFFERNUMBYTES(a3)
move.l #BUFFERSIZE,d3
lea FL_BUFFER(a3),a0
move.l a0,d2
move.l FL_FILEHANDLE(a3),d1
CallDOS Write
tst.l d0
bmi ErrorIO
move.l (sp)+,d3
move.l (sp)+,d2
bra.s FILEPRINT_IT_I_BufferLoop
FILEPRINT_IT_I_BufferNotFull
cmp.l d3,d4
ble.s FILEPRINT_IT_I_D4IsOk
move.l d3,d4
FILEPRINT_IT_I_D4IsOk
; Zahl der noch zu schreibenden Bytes verringern, in den Puffer kopieren
sub.l d4,d3
move.l d2,a0
lea FL_BUFFER(a3),a1
add.l FL_BUFFERNUMBYTES(a3),a1
add.l d4,FL_BUFFERNUMBYTES(a3)
bra.s FILEPRINT_IT_I_EnterCopyLoop
FILEPRINT_IT_I_CopyLoop
move.b (a0)+,(a1)+
FILEPRINT_IT_I_EnterCopyLoop
dbra d4,FILEPRINT_IT_I_CopyLoop
move.l a0,d2
tst.l d3
bgt.s FILEPRINT_IT_I_BufferLoop
Break_On
jmp (a2)
FILES_T_
Break_Off
; Directory of... ausgeben
pea FilesText
bsr PRINT_T_
; Namen holen und untersuchen
move.l (sp)+,a2
move.l (sp)+,a0
move.l a2,-(sp)
move.l (a0),a0
addq.l #2,a0
bsr LockIt
move.l d0,d7
; Namen ausgeben
FILES_T__NextFile
move.l FreeStringPointer(a5),a0
addq.l #4,a0
move.l a0,-4(a0)
move.l a0,a1
clr.w (a1)+
move.l FileInfoBlock(a5),a2
tst.l fib_DirEntryType(a2)
bmi.s FILES_T__NoDir1
move.b #"[",(a1)+
addq.w #1,(a0)
FILES_T__NoDir1
moveq #0,d0
FILES_T__NextChar
tst.b fib_FileName(a2,d0.w)
beq.s FILES_T__LastFound
move.b fib_FileName(a2,d0.w),(a1)+
addq.w #1,(a0)
addq.w #1,d0
cmp.w #108,d0
bne.s FILES_T__NextChar
FILES_T__LastFound
tst.l fib_DirEntryType(a2)
bmi.s FILES_T__NoDir2
move.b #"]",(a1)+
addq.w #1,(a0)
FILES_T__NoDir2
move.b #10,(a1)+
addq.w #1,(a0)
move.l FreeStringPointer(a5),-(sp)
bsr PRINT_T_
move.l d7,d1
move.l FileInfoBlock(a5),d2
CallDOS ExNext
tst.l d0
bne.s FILES_T__NextFile
; Ist ein Fehler aufgetreten?
CallDOS IoErr
cmp.l #232,d0
bne.s FILES_T__Error
move.l d7,d1
CallDOS UnLock
Break_On
rts
FILES_T__Error
move.l d0,ThisIoError(a5)
move.l d7,d1
CallDOS UnLock
bra ErrorIO
FILES__
move.l (sp)+,a2
pea LeerString
move.l a2,-(sp)
bra FILES_T_
INPUT_II_T
Break_Off
move.l (sp)+,d6
move.w (sp)+,d0
bsr ReallyFindFileStruct
move.l a3,a2
cmp.w #IOACCESS_INPUT,FL_ACCESSMODE(a2)
bne ErrorBadFileMode
moveq #0,d7
move.w (sp)+,d7
bmi ErrorIllegalFunctionCall
move.l FL_FILEPOS(a2),d0
sub.l FL_BUFFERNUMBYTES(a2),d0
add.l d7,d0
cmp.l FL_FILELENGTH(a2),d0
bhi ErrorInputPastEnd
move.w d7,a3
bsr CreateString
move.l a3,-(sp)
move.l (a3),a3
move.w d7,(a3)+
move.l d6,-(sp)
INPUT_II_T_AddToString
tst.w d7
beq.s INPUT_II_T_ReachedEnd
lea FL_BUFFER(a2),a0
add.l FL_BUFFEROFFSET(a2),a0
move.l FL_BUFFERNUMBYTES(a2),d0
bra.s INPUT_II_T_EnterLoop
INPUT_II_T_Loop
move.b (a0)+,(a3)+
addq.l #1,FL_BUFFEROFFSET(a2)
subq.l #1,FL_BUFFERNUMBYTES(a2)
subq.w #1,d7
ble.s INPUT_II_T_ReachedEnd
INPUT_II_T_EnterLoop
dbra d0,INPUT_II_T_Loop
move.l FL_FILELENGTH(a2),d0
sub.l FL_FILEPOS(a2),d0
cmp.l #BUFFERSIZE,d0
ble.s INPUT_II_T_D0Ok
move.l #BUFFERSIZE,d0
INPUT_II_T_D0Ok
clr.l FL_BUFFEROFFSET(a2)
move.l d0,FL_BUFFERNUMBYTES(a2)
add.l d0,FL_FILEPOS(a2)
move.l FL_FILEHANDLE(a2),d1
pea FL_BUFFER(a2)
move.l (sp)+,d2
move.l d0,d3
CallDOS Read
tst.l d0
bmi ErrorIO
bra.s INPUT_II_T_AddToString
INPUT_II_T_ReachedEnd
Break_On
bra FinishString
KILL_T_
Break_Off
move.l (sp)+,a2
move.l (sp)+,a0
move.l (a0),d1
addq.l #2,d1
CallDOS DeleteFile
tst.l d0
beq ErrorIO
Break_On
jmp (a2)
LOF_I_L
move.l (sp)+,a2
move.w (sp)+,d0
bsr ReallyFindFileStruct
move.l FL_FILELENGTH(a3),-(sp)
jmp (a2)
NAME_TT_
Break_Off
move.l (sp)+,a2
move.l (sp)+,a1
move.l (sp)+,a0
move.l (a0),d1
move.l (a1),d2
addq.l #2,d1
addq.l #2,d2
CallDOS Rename
tst.l d0
beq ErrorIO
Break_On
jmp (a2)
OPENAPPEND_TI_
Break_Off
; Ist das File schon geöffnet?
move.w 4(sp),d0
bsr FindFileStruct
cmp.l #0,a3
bne ErrorFileAlreadyOpen
; File-Struktur besorgen
move.l #FL_SIZEOF,d0
moveq #0,d1
bsr MyAllocMem
move.l d0,a2
; File-Struktur initialisieren
move.w 4(sp),FL_NUMBER(a2)
move.w #IOACCESS_OUTPUT,FL_ACCESSMODE(a2)
clr.l FL_FILELENGTH(a2)
clr.l FL_BUFFEROFFSET(a2)
clr.l FL_BUFFERNUMBYTES(a2)
clr.l FL_FILEPOS(a2)
; File öffnen
move.l 6(sp),a0
move.l (a0),d1
addq.l #2,d1
move.l #MODE_OLDFILE,d2
CallDOS Open
move.l d0,FL_FILEHANDLE(a2)
beq OPENAPPEND_TI__OpenError
move.l FL_FILEHANDLE(a2),d1
moveq #0,d2
moveq #OFFSET_END,d3
CallDOS Seek
move.l FL_FILEHANDLE(a2),d1
moveq #0,d2
moveq #OFFSET_CURRENT,d3
CallDOS Seek
move.l d0,FL_FILELENGTH(a2)
; in die File-Liste eintragen
move.l FileListPointer(a5),FL_NEXT(a2)
move.l a2,FileListPointer(a5)
; Fertig
Break_On
move.l (sp)+,a2
addq.l #6,sp
jmp (a2)
OPENAPPEND_TI__OpenError
CallDOS IoErr
move.l d0,ThisIoError(a5)
bra ErrorIO
OPENINPUT_TI_
Break_Off
; Ist das File schon geöffnet?
move.w 4(sp),d0
bsr FindFileStruct
cmp.l #0,a3
bne ErrorFileAlreadyOpen
; File-Struktur besorgen
move.l #FL_SIZEOF,d0
moveq #0,d1
bsr MyAllocMem
move.l d0,a2
; File-Struktur initialisieren
move.w 4(sp),FL_NUMBER(a2)
move.w #IOACCESS_INPUT,FL_ACCESSMODE(a2)
clr.l FL_BUFFEROFFSET(a2)
clr.l FL_BUFFERNUMBYTES(a2)
clr.l FL_FILEPOS(a2)
; File öffnen
move.l 6(sp),a0
move.l (a0),d1
addq.l #2,d1
move.l #MODE_OLDFILE,d2
CallDOS Open
move.l d0,FL_FILEHANDLE(a2)
beq OPENINPUT_TI__OpenError
; File-Länge bestimmen
move.l FL_FILEHANDLE(a2),d1
moveq #0,d2
moveq #OFFSET_END,d3
CallDOS Seek
move.l FL_FILEHANDLE(a2),d1
moveq #0,d2
moveq #OFFSET_BEGINNING,d3
CallDOS Seek
move.l d0,FL_FILELENGTH(a2)
; in die File-Liste eintragen
move.l FileListPointer(a5),FL_NEXT(a2)
move.l a2,FileListPointer(a5)
; Fertig
Break_On
move.l (sp)+,a2
addq.l #6,sp
jmp (a2)
OPENINPUT_TI__OpenError
CallDOS IoErr
move.l d0,ThisIoError(a5)
bra ErrorIO
OPENOUTPUT_TI_
Break_Off
; Ist das File schon geöffnet?
move.w 4(sp),d0
bsr FindFileStruct
cmp.l #0,a3
bne ErrorFileAlreadyOpen
; File-Struktur besorgen
move.l #FL_SIZEOF,d0
moveq #0,d1
bsr MyAllocMem
move.l d0,a2
; File-Struktur initialisieren
move.w 4(sp),FL_NUMBER(a2)
move.w #IOACCESS_OUTPUT,FL_ACCESSMODE(a2)
clr.l FL_FILELENGTH(a2)
clr.l FL_BUFFEROFFSET(a2)
clr.l FL_BUFFERNUMBYTES(a2)
clr.l FL_FILEPOS(a2)
; File öffnen
move.l 6(sp),a0
move.l (a0),d1
addq.l #2,d1
move.l #MODE_NEWFILE,d2
CallDOS Open
move.l d0,FL_FILEHANDLE(a2)
beq OPENOUTPUT_TI__OpenError
; in die File-Liste eintragen
move.l FileListPointer(a5),FL_NEXT(a2)
move.l a2,FileListPointer(a5)
; Fertig
Break_On
move.l (sp)+,a2
addq.l #6,sp
jmp (a2)
OPENOUTPUT_TI__OpenError
CallDOS IoErr
move.l d0,ThisIoError(a5)
bra ErrorIO
OPENREADWRITE_TI_
bra ErrorAdvancedFeature
; Versucht File mit Namen in a0 (Zeiger auf Zeiger) zu "locken" und
; zu "examinen" und gibt den Lock in d0 zurück (prüft auf Directory)
LockIt
move.l a0,d1
moveq #ACCESS_READ,d2
CallDOS Lock
move.l d0,d7
beq.s LockIt_CouldNotLockError
move.l d7,d1
move.l FileInfoBlock(a5),d2
CallDOS Examine
tst.l d0
beq.s LockIt_CouldNotExamineError
move.l FileInfoBlock(a5),a0
tst.l fib_DirEntryType(a0)
bmi.s LockIt_NoDirectoryError
move.l d7,d0
rts
LockIt_CouldNotLockError
CallDOS IoErr
move.l d0,ThisIoError(a5)
bra ErrorIO
LockIt_CouldNotExamineError
CallDOS IoErr
move.l d0,ThisIoError(a5)
move.l d7,d1
CallDOS UnLock
bra ErrorIO
LockIt_NoDirectoryError
move.l d7,d1
CallDOS UnLock
bra ErrorNoDirectory
; Filestruktur mit Nummer in d0 suchen, gibt Zeiger auf Struktur in a3 zurück
; (oder 0, wenn nicht gefunden)
FindFileStruct
lea FileListPointer(a5),a3
LookNextFile
move.l FL_NEXT(a3),a3
cmp.l #0,a3
beq.s NoSuchFile
cmp.w FL_NUMBER(a3),d0
bne.s LookNextFile
NoSuchFile
rts
; Gleich wie FindFileStruct, nur wird abgebrochen, wenn das File nicht
; gefunden wurde
ReallyFindFileStruct
bsr FindFileStruct
cmp.l #0,a3
beq ErrorBadFileNumber
rts
; **********************************************************************
; * *
; * Felderfunktionen *
; * *
; **********************************************************************
DIMDOUB_FP_
move.l (sp)+,a2
move.l (sp)+,a0
moveq #3,d7
bsr DimField
move.l FirstLocalField(a5),FIELD_NEXT(a0)
move.l a0,FirstLocalField(a5)
jmp (a2)
DIMINT_FP_
move.l (sp)+,a2
move.l (sp)+,a0
moveq #1,d7
bsr DimField
move.l FirstLocalField(a5),FIELD_NEXT(a0)
move.l a0,FirstLocalField(a5)
jmp (a2)
DIMLONG_FP_
move.l (sp)+,a2
move.l (sp)+,a0
moveq #2,d7
bsr DimField
move.l FirstLocalField(a5),FIELD_NEXT(a0)
move.l a0,FirstLocalField(a5)
jmp (a2)
DIMREAL_FP_
move.l (sp)+,a2
move.l (sp)+,a0
moveq #2,d7
bsr DimField
move.l FirstLocalField(a5),FIELD_NEXT(a0)
move.l a0,FirstLocalField(a5)
jmp (a2)
DIMTEXT_FP_
move.l (sp)+,a2
move.l (sp)+,a0
moveq #2,d7
bsr DimField
move.l FirstLocalField(a5),FIELD_NEXT(a0)
move.l a0,FirstLocalField(a5)
bsr AddTextField
move.l FIELD_MEM(a0),a1
add.l FIELD_MEMSIZE(a0),a1
move.l FIELD_MEM(a0),a0
bsr ClearTextField
jmp (a2)
DIMSHAREDDOUB_FP_
move.l (sp)+,a2
move.l (sp)+,a0
moveq #3,d7
bsr DimField
move.l FirstGlobalField(a5),FIELD_NEXT(a0)
move.l a0,FirstGlobalField(a5)
jmp (a2)
DIMSHAREDINT_FP_
move.l (sp)+,a2
move.l (sp)+,a0
moveq #1,d7
bsr DimField
move.l FirstGlobalField(a5),FIELD_NEXT(a0)
move.l a0,FirstGlobalField(a5)
jmp (a2)
DIMSHAREDLONG_FP_
move.l (sp)+,a2
move.l (sp)+,a0
moveq #2,d7
bsr DimField
move.l FirstGlobalField(a5),FIELD_NEXT(a0)
move.l a0,FirstGlobalField(a5)
jmp (a2)
DIMSHAREDREAL_FP_
move.l (sp)+,a2
move.l (sp)+,a0
moveq #2,d7
bsr DimField
move.l FirstGlobalField(a5),FIELD_NEXT(a0)
move.l a0,FirstGlobalField(a5)
jmp (a2)
DIMSHAREDTEXT_FP_
move.l (sp)+,a2
move.l (sp)+,a0
moveq #2,d7
bsr DimField
move.l FirstGlobalField(a5),FIELD_NEXT(a0)
move.l a0,FirstGlobalField(a5)
bsr AddTextField
move.l FIELD_MEM(a0),a1
add.l FIELD_MEMSIZE(a0),a1
move.l FIELD_MEM(a0),a0
bsr ClearTextField
jmp (a2)
DimField
move.l (sp)+,d6
tst.l FIELD_MEM(a0)
bne ErrorDuplicateDefinition
lea FIELD_NUMDIMS(a0),a1
move.w (sp)+,d0
move.w d0,(a1)+
moveq #1,d1
DimFieldLoop
moveq #0,d2
move.w (sp)+,d2
bmi ErrorIllegalFunctionCall
addq.l #1,d2
move.w d2,(a1)+
move.l d1,d3
swap d3
mulu d2,d3
swap d3
tst.w d3
bne ErrorIllegalFunctionCall
mulu d2,d1
add.l d3,d1
bvs ErrorIllegalFunctionCall
dbra d0,DimFieldLoop
lsl.l d7,d1
move.l d1,FIELD_MEMSIZE(a0)
move.l d1,d0
moveq #0,d1
bsr MyAllocMem
move.l d0,FIELD_MEM(a0)
move.l d6,-(sp)
rts
GETDOUBELEM_FP_D
move.l (sp)+,a2
moveq #3,d7
bsr GetElemPointer
move.l (a0)+,d0
move.l (a0),-(sp)
move.l d0,-(sp)
jmp (a2)
GETINTELEM_FP_I
move.l (sp)+,a2
moveq #1,d7
bsr GetElemPointer
move.w (a0),-(sp)
jmp (a2)
GETLONGELEM_FP_L
move.l (sp)+,a2
moveq #2,d7
bsr GetElemPointer
move.l (a0),-(sp)
jmp (a2)
GETREALELEM_FP_R
move.l (sp)+,a2
moveq #2,d7
bsr GetElemPointer
move.l (a0),-(sp)
jmp (a2)
GETTEXTELEM_FP_T
move.l (sp)+,a2
moveq #2,d7
bsr GetElemPointer
move.l a0,-(sp)
jmp (a2)
GETDOUBELEMPOINTER_FP_L
move.l (sp)+,a2
moveq #3,d7
bsr GetElemPointer
move.l a0,-(sp)
jmp (a2)
GETINTELEMPOINTER_FP_L
move.l (sp)+,a2
moveq #1,d7
bsr GetElemPointer
move.l a0,-(sp)
jmp (a2)
GETLONGELEMPOINTER_FP_L
move.l (sp)+,a2
moveq #2,d7
bsr GetElemPointer
move.l a0,-(sp)
jmp (a2)
GETREALELEMPOINTER_FP_L
move.l (sp)+,a2
moveq #2,d7
bsr GetElemPointer
move.l a0,-(sp)
jmp (a2)
GETTEXTELEMPOINTER_FP_L
move.l (sp)+,a2
moveq #2,d7
bsr GetElemPointer
move.l a0,-(sp)
jmp (a2)
SETDOUBELEM_DFP_
move.l (sp)+,a2
moveq #3,d7
bsr GetElemPointer
move.l (sp)+,(a0)+
move.l (sp)+,(a0)
jmp (a2)
SETINTELEM_IFP_
move.l (sp)+,a2
moveq #1,d7
bsr GetElemPointer
move.w (sp)+,(a0)
jmp (a2)
SETLONGELEM_LFP_
move.l (sp)+,a2
moveq #2,d7
bsr GetElemPointer
move.l (sp)+,(a0)
jmp (a2)
SETREALELEM_RFP_
move.l (sp)+,a2
moveq #2,d7
bsr GetElemPointer
move.l (sp)+,(a0)
jmp (a2)
SETTEXTELEM_TFP_
move.l (sp)+,a2
moveq #2,d7
bsr GetElemPointer
move.l (sp)+,a1
move.l (a1),(a0)
jmp (a2)
; a2 darf nicht verändert werden, das Ergebnis steht in a0 (Zeiger auf Elem)
GetElemPointer
move.l (sp)+,d6
move.l (sp)+,a0
tst.l FIELD_MEM(a0)
beq ErrorSubscriptOutOfRange
move.w (sp)+,d1
cmp.w FIELD_NUMDIMS(a0),d1
bne ErrorSubscriptOutOfRange
lea FIELD_FIRSTDIM(a0),a1
moveq #0,d0 ; Elementnummer
GetElemNumLoop
move.w (a1)+,d3 ; Faktor holen
move.l d0,d4
swap d4
mulu d3,d4
swap d4
mulu d3,d0
add.l d4,d0
moveq #0,d2
move.w (sp)+,d2
cmp.w d3,d2
bcc ErrorSubscriptOutOfRange
add.l d2,d0
dbra d1,GetElemNumLoop
lsl.l d7,d0
move.l FIELD_MEM(a0),a0
add.l d0,a0
move.l d6,-(sp)
rts
; **********************************************************************
; * *
; * Fehlerbehandlung *
; * *
; **********************************************************************
;
; Darf sich nur auf die Libraries verlassen!
;
Error
Break_Off
move.b #-1,ErrorOccured(a5)
; Text für den Fehler suchen
lea ErrorTable,a2
FindingLoop
move.b (a2)+,d1
bmi.s EndOfTableReached
cmp.b d1,d0
beq.s FoundErrorText
FindEndOfErrorText
tst.b (a2)+
bne.s FindEndOfErrorText
bra.s FindingLoop
FoundErrorText
EndOfTableReached
CallDOS Output
move.l d0,d7
ble NoStdOutPut
move.l d7,d1
move.l #ErrorText1,d2
moveq #ErrorText1End-ErrorText1,d3
CallDOS Write
move.l d7,d1
move.l a2,d2
FindEndLoop
tst.b (a2)+
bne.s FindEndLoop
move.l a2,d3
sub.l d2,d3
subq.l #1,d3
CallDOS Write
tst.l ThisSourceLine(a5)
beq NoSourceLineSet
move.l d7,d1
move.l #ErrorLineText1,d2
moveq #ErrorLineText1End-ErrorLineText1,d3
CallDOS Write
lea ErrorLongVarString,a0
lea ThisSourceLine(a5),a1
lea RawDoFmtProc,a2
lea ErrorLongBuffer(a5),a3
CallSys RawDoFmt
move.l d7,d1
lea ErrorLongBuffer(a5),a0
move.l a0,d2
FindErrorLineEndLoop
tst.b (a0)+
bne.s FindErrorLineEndLoop
move.l a0,d3
sub.l d2,d3
subq.l #1,d3
CallDOS Write
move.l d7,d1
move.l #ErrorLineText2,d2
moveq #ErrorLineText2End-ErrorLineText2,d3
CallDOS Write
NoSourceLineSet
move.l d7,d1
move.l #ErrorText2,d2
moveq #ErrorText2End-ErrorText2,d3
CallDOS Write
bra END___NoCheck
ErrorText1 dc.b 13,'Basic-Error: '
ErrorText1End
ErrorLineText1 dc.b ' (Line '
ErrorLineText1End
ErrorLineText2 dc.b ')'
ErrorLineText2End
ErrorText2 dc.b 10
ErrorText2End
ErrorLongVarString dc.b '%ld',0
even
NoStdOutPut
lea IntuiText(a5),a0
clr.b (a0)+
move.b #1,(a0)+
move.b #1,(a0)+
clr.b (a0)+
move.w #10,(a0)+
move.w #10,(a0)+
clr.l (a0)+
move.l a2,(a0)+
clr.l (a0)
sub.l a0,a0
lea IntuiText(a5),a1
sub.l a2,a2
lea ContinueIntuiText,a3
moveq #0,d0
moveq #0,d1
move.l #400,d2
moveq #60,d3
CallIntuition AutoRequest
bra END___NoCheck
ContinueIntuiText
dc.b 0,1,1,0
dc.w 5,3
dc.l 0,PositiveText,0
PositiveText
dc.b " Continue",0
even
; Fehlertabelle
ErrorTable
dc.b 03,'RETURN without GOSUB',0
dc.b 04,'Out of data',0
dc.b 05,'Illegal function call',0
dc.b 06,'Overflow',0
dc.b 07,'Out of memory',0
dc.b 09,'Subscript out of range',0
dc.b 10,'Duplicate definition',0
dc.b 11,'Division by zero',0
dc.b 14,'Out of heap space',0
dc.b 15,'String too long',0
dc.b 19,'No RESUME',0
dc.b 20,'RESUME without error',0
dc.b 23,'Line buffer overflow',0
dc.b 50,'FIELD overflow',0
dc.b 52,'Bad file number',0
dc.b 53,'File not found',0
dc.b 54,'Bad file mode',0
dc.b 55,'File already open',0
dc.b 57,'Device I/O error',0
dc.b 58,'File already exists',0
dc.b 61,'Disk full',0
dc.b 62,'Input past end',0
dc.b 63,'Bad record number',0
dc.b 64,'Bad file name',0
dc.b 68,'Device unavailable',0
dc.b 70,'Permission denied',0
dc.b 73,'Advanced feature',0
dc.b 74,'Unknown Volume',0
dc.b 100,'Cannot open Window',0
dc.b 101,'Stack overflow',0
dc.b 102,'Internal Error: FreeMem',0
dc.b 103,'Could not open Console',0
dc.b 104,'No math.library',0
dc.b 105,'No mathtrans.library',0
dc.b 106,'No mathieeedoubbas.library',0
dc.b 107,'No mathieeedoubtrans.library',0
dc.b 108,'Garbagecollection out of Memory',0
dc.b 109,'I/O error',0
dc.b 110,'File is not a directory',0
dc.b 111,'Internal error: stack trashed',0
dc.b 112,'Could not alloc trap 7',0
dc.b -1,"Unprintable error",0
even
ErrorReturnWithoutGosub
moveq #3,d0
bra Error
ErrorOutOfData
moveq #4,d0
bra Error
ErrorIllegalFunctionCall
moveq #5,d0
bra Error
ErrorOverflow
moveq #6,d0
bra Error
ErrorOutOfMemory
moveq #7,d0
bra Error
ErrorSubscriptOutOfRange
moveq #9,d0
bra Error
ErrorDuplicateDefinition
moveq #10,d0
bra Error
ErrorDivisionByZero
moveq #11,d0
bra Error
ErrorOutOfHeapSpace
moveq #14,d0
bra Error
ErrorStringTooLong
moveq #15,d0
bra Error
ErrorNoResume
moveq #19,d0
bra Error
ErrorResumeWithoutError
moveq #20,d0
bra Error
ErrorLineBufferOverflow
moveq #23,d0
bra Error
ErrorFieldOverflow
moveq #50,d0
bra Error
ErrorBadFileNumber
moveq #52,d0
bra Error
ErrorFileNotFound
moveq #53,d0
bra Error
ErrorBadFileMode
moveq #54,d0
bra Error
ErrorFileAlreadyOpen
moveq #55,d0
bra Error
ErrorDeviceIoError
moveq #57,d0
bra Error
ErrorFileAlreadyExists
moveq #58,d0
bra Error
ErrorDiskFull
moveq #61,d0
bra Error
ErrorInputPastEnd
moveq #62,d0
bra Error
ErrorBadRecordNumber
moveq #63,d0
bra Error
ErrorBadFileName
moveq #64,d0
bra Error
ErrorDeviceUnavailable
moveq #68,d0
bra Error
ErrorPermissionDenied
moveq #70,d0
bra Error
ErrorAdvancedFeature
moveq #73,d0
bra Error
ErrorUnknownVolume
moveq #74,d0
bra Error
ErrorCannotOpenWindow
moveq #100,d0
bra Error
ErrorStackOverflow
moveq #101,d0
bra Error
ErrorFreeMem
moveq #102,d0
bra Error
ErrorCouldNotOpenConsole
moveq #103,d0
bra Error
ErrorNoMathLibrary
moveq #104,d0
bra Error
ErrorNoMathTransLibrary
moveq #105,d0
bra Error
ErrorNoMathIeeeDoubBasLibrary
moveq #106,d0
bra Error
ErrorNoMathIeeeDoubTransLibrary
moveq #107,d0
bra Error
ErrorGarbageCollectionOutOfMemory
moveq #108,d0
bra Error
ErrorIO
moveq #109,d0
bra Error
ErrorNoDirectory
moveq #110,d0
bra Error
ErrorStackTrashed
moveq #111,d0
bra Error
ErrorNoTrapSeven
moveq #112,d0
bra Error
; Tabelle der Ein-/Ausgabefehler
IOErrorTable:
dc.b 103,'NO FREE STORE',0
dc.b 105,'TASK TABLE FULL',0
dc.b 120,'LINE TOO LONG',0
dc.b 121,'FILE NOT OBJECT',0
dc.b 122,'INVALID RESIDENT LIBRARY',0
dc.b 201,'NO DEFAULT DIR',0
dc.b 202,'OBJECT IN USE',0
dc.b 203,'OBJECT EXISTS',0
dc.b 204,'DIR NOT FOUND',0
dc.b 205,'OJBECT NOT FOUND',0
dc.b 206,'BAD STREAM NAME',0
dc.b 207,'OBJECT TOO LARGE',0
dc.b 209,'ACTION NOT KNOWN',0
dc.b 210,'INVALID COMPONENT NAME',0
dc.b 211,'INVALID LOCK',0
dc.b 212,'OBJECT WRONG TYPE',0
dc.b 213,'DISK NOT VALIDATED',0
dc.b 214,'DISK WRITE PROTECTED',0
dc.b 215,'RENAME ACROSS DEVICES',0
dc.b 216,'DIRECTORY NOT EMPTY',0
dc.b 217,'TOO MANY LEVELS',0
dc.b 218,'DEVICE NOT MOUNTED',0
dc.b 219,'SEEK ERROR',0
dc.b 220,'COMMENT TOO BIG',0
dc.b 221,'DISK FULL',0
dc.b 222,'DELETE PROTECTED',0
dc.b 223,'WRITE PROTECTED',0
dc.b 224,'READ PROTECTED',0
dc.b 225,'NOT A DOS DISK',0
dc.b 226,'NO DISK',0
dc.b 232,'NO MORE ENTRIES',0
dc.b -1
; **********************************************************************
; * *
; * Stringunterstützung *
; * *
; **********************************************************************
; Um einen String zu erzeugen muß CreateString aufgerufen werden.
; In A3.w steht zunächst die größtmögliche Länge des Strings oder die
; genau Länge (wird zum Test auf Garbage-Collection benutzt)
; A3 zeigt dann auf einen Zeiger auf die Länge des neuen Strings.
; Auf jedes CreateString muß ein FinishStringCGarbage folgen!
CreateString
movem.l d0/d1/a0,-(sp)
; Auf Garbage-Collection testen
move.w a3,d0
bmi ErrorStringTooLong
ext.l d0
addq.l #8,d0
bclr #0,d0
add.l FreeStringPointer(a5),d0
move.l StringsMem(a5),d1
add.l StringsMemSize(a5),d1
cmp.l d1,d0
blt.s NoNeedGarbageCollection
sub.l FreeStringPointer(a5),d0
movem.l d0-a3,-(sp)
bsr DoGarbageCollection
movem.l (sp)+,d0-a3
add.l FreeStringPointer(a5),d0
cmp.l d1,d0
bge ErrorGarbageCollectionOutOfMemory
NoNeedGarbageCollection
; Neuen String besorgen
move.l FreeStringPointer(a5),a3
clr.l (a3)+
move.w TempNumber(a5),d0
lsl.w #2,d0
lea TempMem(a5,d0.w),a0
move.l a3,(a0)
move.l a0,a3
move.w TempNumber(a5),d0
addq.w #1,d0
cmp.w #MAXTEMP,d0
bne.s NotLastPosReached
moveq #0,d0
NotLastPosReached
move.w d0,TempNumber(a5)
movem.l (sp)+,d0/d1/a0
rts
; FinishString geht davon aus, daß FreeStringPointer(a5) noch erhöht werden
; muß. Beim Aufruf von FinishString zeigt er auf das Longword vor der Länge
; des neu hinzugefügten Strings. Es wird ein Nullbyte hinten an den String
; angefügt (für C-Strings).
; Auf jedes CreateString muß ein FinishString folgen!
FinishString
movem.l d0/a0,-(sp)
; alten String fertig machen
move.l FreeStringPointer(a5),a0
addq.l #4,a0
add.w (a0)+,a0
clr.b (a0)+
move.l a0,d0
addq.l #1,d0
bclr #0,d0
move.l d0,FreeStringPointer(a5)
movem.l (sp)+,d0/a0
rts
; **********************************************************************
; * *
; * Garbage-Collection ausführen *
; * *
; **********************************************************************
DoGarbageCollection
; Grenzen des Speichers für Strings
move.l StringsMem(a5),d4
move.l d4,d5
add.l StringsMemSize(a5),d5
; Pass1
; Markieren der noch benötigten Strings
lea TempField(a5),a0
Pass1_NextTextField
move.l FIELD_MEM(a0),a1
move.l FIELD_MEMSIZE(a0),d0
bra.s Pass1_EnterLoop
Pass1_Loop
move.l (a1)+,a2
tst.w (a2)
beq.s Pass1_StringEmpty
cmp.l d4,a2
blt.s Pass1_NotInStringsMem
cmp.l d5,a2
bgt.s Pass1_NotInStringsMem
move.w #1,-(a2) ; Diesen String markieren
Pass1_NotInStringsMem
Pass1_StringEmpty
Pass1_EnterLoop
subq.l #4,d0
bpl.s Pass1_Loop
move.l FIELD_TEXTSUCC(a0),a0
move.l a0,d0
bne.s Pass1_NextTextField
; Pass2
; Errechnen der neuen Stellen der Strings
move.l StringsMem(a5),a0
addq.l #4,a0 ; a0: Zeiger auf alte Position
move.l a0,a1 ; a1: Zeiger auf die neue Position
Pass2_NotReady
move.w (a0),d0 ; d0: Offset zum nächsten String
addq.w #8,d0
bclr #0,d0
tst.w -2(a0) ; Ist dieser markiert?
beq.s Pass2_StringNotNeeded
move.l a1,-4(a0) ; Neue Position eintragen
add.w d0,a1 ; auch neuen Zeiger erhöhen
Pass2_StringNotNeeded
add.w d0,a0 ; zum nächsten String
cmp.l FreeStringPointer(a5),a0
blt.s Pass2_NotReady
; Pass3
; Ändern der Zeiger der String-Variablen
lea TempField(a5),a0
Pass3_NextTextField
move.l FIELD_MEM(a0),a1
move.l FIELD_MEMSIZE(a0),d0
bra.s Pass3_EnterLoop
Pass3_Loop
move.l (a1),a2
tst.w (a2)
beq.s Pass3_StringEmpty
cmp.l d4,a2
blt.s Pass3_NotInStringsMem
cmp.l d5,a2
bgt.s Pass3_NotInStringsMem
move.l -4(a2),(a1)
bra.s Pass3_StringNotEmpty
Pass3_StringEmpty
lea NullWord,a2
move.l a2,(a1)
Pass3_StringNotEmpty
Pass3_NotInStringsMem
addq.l #4,a1
Pass3_EnterLoop
subq.l #4,d0
bpl.s Pass3_Loop
move.l FIELD_TEXTSUCC(a0),a0
move.l a0,d0
bne.s Pass3_NextTextField
; Pass4
; Zusammenkopieren der Strings
move.l StringsMem(a5),a1 ; Zeiger auf das Ziel der Strings
lea 4(a1),a0 ; Zeiger zum Auslesen der alten Strings
Pass4_Loop
cmp.l FreeStringPointer(a5),a0
bge.s Pass4_Ready
move.w (a0)+,d0
tst.l -6(a0)
beq.s Pass4_SkipThisString
clr.l (a1)+
move.w d0,(a1)+
lsr.w #1,d0
Pass4_WordCopyLoop
move.w (a0)+,(a1)+
dbra d0,Pass4_WordCopyLoop
addq.l #4,a0
bra.s Pass4_Loop
Pass4_SkipThisString
addq.w #6,d0
bclr #0,d0
add.w d0,a0
bra.s Pass4_Loop
Pass4_Ready
move.l a1,FreeStringPointer(a5)
rts
END